FM Towns: Free Software Collection 6

home *** CD-ROM | disk | FTP | other *** search

/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / t_os / ampaint / source / ampaint.bas

Wrap

BASIC Source File | 1993-07-08 | 90.3 KB | 1,321 lines

5 CLEAR ,,512,990000,32768:GOSUB *CHKCMP:SCREEN@ 0 10 DEFINT A-Z:VERS$="0.99i-h":VDATE$="93/ 2/14":GC=0 20 DIM GB%(163839),MG%(38399),MGB%(38399),CM%(5985),PP%(15),PPC%(127),BUT%(50,3),BV%(50,1),GC%(9),PSP%(927),HSP%(927),PSP2%(7423),PSP3%(7423),FLG%(721,3),GAV%(255),RAV%(255),BAV%(255),CDDAT%(10),CDT%(3),CP&(127),WFP%(8191) 22 DIM ST%(38399),EGBWORK%(1000),GETREG&(10),PARA%(100),PALT%(1025,1),LBUF%(32768,1),SCMV%(2),OMS%(32767) 25 DIM EF1%(927),EF2%(927),EF3%(927),EF4%(927),GS!(32),STP0%(3839),CUTP%(19199),WPP%(3),LED%(6),BOW%(2,7),ADS%(255) 27 FOR A=129 TO 254:ADS%(A)=(A-128)*2:NEXT:FOR A=1 TO 127:ADS%(A)=A*2+1:NEXT 28 DIM STPM0%(63),STPM1%(63),STPM2%(63),STPM3%(63),STPM4%(63),STPM5%(63),STPM6%(63),STPM7%(63),STPM8%(63),STPM9%(63),STPM10%(63),STPM11%(63),STPM12%(63),STPM13%(63),STPM14%(63) 30 DIM FILE_NAME$(256),RADBUT$(9),RETFLG(9),XY(20,4),WC(12),DICN%(191) 'for File Dialog 40 DEF FNFF$(F$)=LEFT$(KLEFT$(F$,KINSTR(F$+" .",".")-1)+SPACE$(8),8)+LEFT$(KMID$(F$,KINSTR(F$+" .","."),4)+SPACE$(4),4):DEF FNF$(F)=RIGHT$(" "+STR$(F),3):DEF FNMP$(A&)=MID$(MKL$(A& AND &HFFFF00),2,2) 45 DEF FNP1$(A&)=CHR$(A& AND &HFF):DEF FNP2$(A&)=CHR$((A& AND &HFF00)\256):DEF FNP(A,B)=PEEK(VARPTR(PALT%(0,0))+8*A+8+B) 50 EGB=0:TS=1024:TL=10240:OFFSET&=20480:FDX=16:FDY=2:FDXM=FDX*8:FDYM=FDY*19:MAXCMD=12:CANCMD=9:BUTCMD=12:RADBUT=10:RCMD=0:WC$="*.*":TM$=SPACE$(8):FDM$=SPACE$(68):RIFLG=0:BASCOM=BICF 60 INFOR$=STRING$(200,0):DIR$=SPACE$(65):DRV_SET$=STRING$(26,0):FILENAME$=SPACE$(15):KAKUNO$=FILENAME$:PATH_ALL$=WC$:DUMMYY$=SPACE$(14):DUMMYP$="."+CHR$(0):FOR A=0 TO 256:FILE_NAME$(A)=SPACE$(16):NEXT:FOR A=0 TO 9:RADBUT$(A)=SPACE$(60):NEXT 70 PATH$=SPACE$(255):DRIVE$=SPACE$(255):F_NAME$=SPACE$(255):GOSUB *CDINFO 80 GOSUB *CDGETT:IF CDC<>0 THEN CD STOP 81 LOADM ".\egbcall.rex",EGB:LOADM ".\tiffsave.REX",TS:LOADM ".\tiffload.REX",TL:A&=CALLM(EGB,0,VARPTR(ST%(32867))+1,VARPTR(EGBWORK%(0)),1536):LOADM ".\BAS_LIB.REX",OFFSET&:LOAD@ ".\ampaint.pmb":LOAD@ ".\ampaint.fmb" 82 AH=1:AL=&H80:EDX&=1024:EBX&=512:ECX&=1:ESI&=VARPTR(OMS%(0)):GOSUB *EGB 83 GW&=VARPTR(EGBWORK%(0)):GOSUB *INIT:GOSUB *CDCONTT:GOSUB *CDSTART:GOSUB *ABOUT_WRT:ON KEY(6) GOSUB *NZF:KEY(6) ON:ON KEY(7) GOSUB *STPAD:KEY(7) ON:ON KEY(8) GOSUB *PLSV:KEY(8) ON 85 ON KEY (1) GOSUB *CDSTART:ON KEY (2) GOSUB *CDSTOP:ON KEY (3) GOSUB *CDPAUSE:ON KEY (4) GOSUB *CDCONT:ON KEY (9) GOSUB *CDPREV:ON KEY (10) GOSUB *CDNEXT:KEY(1) ON:KEY(2) ON:KEY(3) ON:KEY(4) ON:KEY(9) ON:KEY(10) ON 90 WAIT 100:GOSUB *PAL_INI:GOSUB *GET_PALETTE:PUT@A (MENX,0)-(MENX+159,479),MG%:GOSUB *COLDISP:GOSUB *FLGINI:GOSUB *MOS_INI:GOSUB *EVENT_LOOP 100 ' 110 END 120 *MOS_INI:MOUSE 0:MOUSE 1,,,1:RETURN 130 *MOS_WAIT:WHILE MOUSE(2,0)=0:GOSUB *PAL_SHIFT:WEND:RETURN 140 *CHKCMP:BICF=1:RETURN 150 *PLAY:IF SNDFV=1 THEN PLAY OFF:PLAY MML$,MML1$,MML2$,MML3$:MML1$="":MML2$="":MML3$="" 151 MML1$="":MML2$="":MML3$="":RETURN 152 *PLAYNO:IF SNDFV=1 THEN PLAY MML$,MML1$,MML2$,MML3$ 153 MML1$="":MML2$="":MML3$="":RETURN 155 *PCM:IF SNDFV=1 THEN PLAY OFF:PLAY ,,,,MML$,MML1$,MML2$,MML3$ 156 MML1$="":MML2$="":MML3$="":RETURN 157 *PPLAY:IF SNDFV=1 THEN PLAY OFF:PLAY MML$,MML1$,,,MML2$,MML3$ 158 MML1$="":MML2$="":MML3$="":RETURN 159 *PCMT:PLAY OFF:PART 4,6:PART 5,7:PART 6,8:PART 7,9:PLAY ,,,,MML$,MML1$:RETURN 170 *PLSV:PLSV=1-PLSV:RETURN 180 *STPAD:STP=STP+1:IF STP>32 THEN STP=1:RETURN ELSE RETURN 190 *NZF:NZF=1-NZF:RETURN 200 *INIT:GOSUB *GET_STARTUP:PART 4,6:PART 5,7:PART 6,8:PART 7,9 210 GOSUB *CAMGET:GOSUB *SCMODE:PALETTE:COLOR ,,7:GOSUB *VW0:LINE (0,0)-(1023,511),PSET,%255,BF:GET@A (0,0)-(159,479),MGB% 215 LOAD@ ".\MENU.TIF":GET@A (0,0)-(159,479),MG%:GET@A (6,367)-(151,448),CM%:LOAD@ ".\menu2.tif",(640,0):LOAD@ ".\menu3.tif",(640,208) 220 GET@ (641,1)-(784,103),PSP%,%GC:GET@ (641,105)-(784,207),HSP%,%GC:GET@A (641,209)-(784,311),PSP2%:GET@A (641,313)-(784,415),PSP3% 222 LOAD@ ".\menu4.tif",(640,0):GET@ (641,1)-(784,103),EF1%,%GC:GET@ (641,105)-(784,207),EF2%,%GC:GET@ (641,209)-(784,311),EF3%,%GC:GET@ (641,313)-(784,415),EF4%,%GC:EF=4 223 LOAD@ ".\menu5.tif",(960,0):GET@A (928,0)-(1023,479),ST%:CALLM OFFSET&,9,&H14,VARPTR(ST%(0)),&H130,STMP&,46080 '32パターンを4つ登録した場合は､TIFFファイルを928からロード 225 CMDV=0:MENX=0:COLV=0:PALF=1:SP=1:WREF=0:DOF=8:PS=16:MDV=9:FOR A=0 TO 15:PP%(A)=-1:NEXT:GOSUB *COLDISP:EX=170:EY=200:FOR A=0 TO 255:GAV%(A)=-1:RAV%(A)=1:BAV%(A)=-1:NEXT:PST=1:STP=20:NZF=0:PCHG=3:BWF=0:PCF=0:WFV=1:WFCMD=1:UNDOV=23:SNDFV=0:PCM=0 230 GOSUB *DATSET:RESTORE *B_DATA:READ CMDN:FOR A=0 TO CMDN-1:FOR B=0 TO 3:READ BUT%(A,B):NEXT:READ BV%(A,0):READ BV%(A,1):NEXT:RETURN 240 *FLGINI:FOR A=1 TO 4:GET@A (BUT%(A,0),BUT%(A,1))-(BUT%(A,2),BUT%(A,3)),FLG%,722*(A-1):NEXT:FLG%=1:YN=PALF:GOSUB *FLGSW:FLG%=2:YN=SP:GOSUB *FLGSW:FLG%=3:YN=WREF:GOSUB *FLGSW:FLG%=4:YN=SNDFV:GOSUB *FLGSW:RETURN 250 *B_DATA:DATA 30, 0,0,159,41,1,0, 3,51,40,88,13,0, 41,51,78,88,12,0, 79,51,116,88,22,0, 117,51,154,88,25,0 260 DATA 3,96,40,133,5,1, 41,96,78,133,6,1, 79,96,116,133,7,1, 117,96,154,133,9,1, 3,141,40,178,15,1, 41,141,78,178,16,1, 79,141,116,178,8,1, 117,141,154,178,21,1, 3,186,40,223,24,0, 41,186,78,223,26,1, 79,186,116,223,0,0, 117,186,154,223,0,0 270 DATA 3,231,40,268,20,0, 41,231,78,268,0,0, 79,231,116,268,23,0, 117,231,154,268,11,0, 3,276,40,313,14,0, 41,276,78,313,17,0, 79,276,116,313,18,0, 117,276,154,313,19,0, 3,321,40,358,4,0, 41,321,78,358,3,0, 79,321,116,358,0,0, 117,321,154,358,2,0 280 DATA 6,367,151,471,10,0 300 *ABOUT 310 GET@A (MENX,0)-(MENX+159,479),MG%:GOSUB *ABOUT_WRT:WHILE MOUSE(2,0)=0:GOSUB *PAL_SHIFT:WEND:WHILE MOUSE(6,0)=0:GOSUB *PAL_SHIFT:WEND:PUT@A (MENX,0)-(MENX+159,479),MG%:GOSUB *UNDOCMD:RETURN 350 *ABOUT_WRT 360 LINE (MENX,41)-(MENX+159,479),PSET,0,BF,&HFF00FF00FF00FF0000FF00FF00FF00FF:LINE (MENX+2,43)-(MENX+157,477),PSET,7,BF,0 370 SYMBOL (MENX+20,60),"Version "+VERS$,1,1,%245:SYMBOL (MENX+60,80),VDATE$,1,1,%245:SYMBOL (MENX+8,98),"(First Release 91/08/18)",.75!,1,%225 380 SYMBOL (MENX+4,120),"(C)1991,1992-",1,1,%200:SYMBOL (MENX+6,140),"Studio",1,1,%200:SYMBOL (MENX+2,160)," Aspergillus Valley",1,1,%200:SYMBOL (MENX+18,180),"& ＯｃＴｏｈ[ｵｸﾄ]",1,1,%200 390 SYMBOL (MENX+4,200),"All Programming",1,1,%180:SYMBOL (MENX+10,220),"by ＯｃＴｏｈ[ｵｸﾄ]",1,1,%180 400 SYMBOL (MENX+8,280)," このエディタは､",1,1,%140:SYMBOL (MENX+8,300),"描くことを楽しむ為",1,1,%140:SYMBOL (MENX+8,320),"のソフトです｡",1,1,%140 410 SYMBOL (MENX+8,340)," 失敗など気にしな",1,1,%140:SYMBOL (MENX+8,360),"いで、気軽にマウス",1,1,%140:SYMBOL (MENX+8,380),"を動かしましょう｡",1,1,%140 420 SYMBOL (MENX+12,420),"Let's Joyful",1,1,%25:SYMBOL (MENX+84,440),"Painting!",1,1,%25:IF BICF=1 THEN M$=" F-BASIC386コンパイラ版" ELSE M$="F-BASIC386インタプリタ版" 430 SYMBOL (MENX+8,461),M$,.75!,1,%245 490 RETURN 500 *COLDISP:LINE (MENX+7,368)-(MENX+150,470),PSET,%COLV,BF:RETURN 510 *COLDISP2:LINE (MENX+7,449)-(MENX+150,470),PSET,%COLV,BF:RETURN 520 *MENUOFF:GET@A (MENX,0)-(MENX+159,479),MG%:PUT@A (MENX,0)-(MENX+159,479),MGB%:RETURN 530 *MENUWRT:GET@A (MENX,0)-(MENX+159,479),MGB%:PUT@A (MENX,0)-(MENX+159,479),MG%:RETURN 540 *MENUMOVE:GOSUB *MENUOFF:MENX=480-MENX:GOSUB *MENUWRT:RETURN 550 *UNDOCMD:CMDV=OCMDV:STF=OSTF:RETURN 560 *MXY:M&=CALLM(OFFSET&,8):MX=MOUSE(0)+(INT(RND(1)*(40-M&*2))-20+M&)*WREF:MY=MOUSE(1)+(INT(RND(1)*(40-M&*2))-20+M&)*WREF 570 IF MX<0 THEN MX=0 ELSE IF MX>639 THEN MX=639 580 IF MY<0 THEN MY=0 ELSE IF MY>479 THEN MY=479 590 RETURN 600 *WRTDOT 610 GOSUB *MXY:IF PCF=0 THEN PUT@ (MX-DOF,MY-DOF)-(MX-DOF+15,MY-DOF+15),PP%,PSET,%COLV ELSE PUT@A (MX-DOF,MY-DOF)-(MX-DOF+15,MY-DOF+15),PPC%,MATTE,,,%255 620 IF PCM=0 THEN MML$="C64":GOSUB *PLAY 630 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0 640 RETURN 650 *WRTDOT3 660 GOSUB *MXY:PSET (MX,MY),%COLV 670 MML$="E64":GOSUB *PLAY:IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0 680 RETURN 700 *WRTLINE2 710 GOSUB *MXY:LINE -(MX,MY),PSET,%COLV 720 MML$="G64":GOSUB *PLAY:IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0 730 RETURN 750 *WRTDOT2 760 GOSUB *WRTDOT:LDX2=MX:LDY2=MY 770 RETURN 800 *WRTLINE 810 LDX1=LDX2:LDY1=LDY2:GOSUB *MXY:LDX2=MX:LDY2=MY:GOSUB *LINE_DRAW 820 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0 830 RETURN 850 *PSET:M&=CALLM(OFFSET&,8):X=X+(INT(RND(1)*(40-M&*2))-20+M&)*WREF:Y=Y+(INT(RND(1)*(40-M&*2))-20+M&)*WREF 860 IF PCF=0 THEN PUT@ (X-DOF,Y-DOF)-(X-DOF+15,Y-DOF+15),PP%,PSET,%COLV ELSE PUT@A (X-DOF,Y-DOF)-(X-DOF+15,Y-DOF+15),PPC%,MATTE,,,%255 870 MML$="B64":GOSUB *PLAYNO:IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0 880 RETURN 1000 *EVENT_LOOP:MOUSE 1,,,1:A=MOUSE(6,0):A&=FRE(1):A&=CALLM(OFFSET&,8):IF (A& AND 2)=2 THEN LINE (MENX+8,460)-(MENX+149,469),PSET,0,BF:SYMBOL (MENX+8,461),RIGHT$(" "+STR$(FRE(1)),14)+"free",1,.5!,7 1010 WHILE MOUSE(2,0)=0:IF MOUSE(2,1)<>0 THEN WHILE MOUSE(6,1)=0:WEND:GOSUB *MENUMOVE 1020 GOSUB *PAL_SHIFT:GOSUB *CDCHK 1030 'GOSUB *DO_FLG 1090 WEND:GOSUB *MENUCHK:IF YN=1 THEN WHILE MOUSE(6,0)=0:WEND ELSE 1510 1500 MX=MOUSE(0):MY=MOUSE(1):GOSUB *CHECK_BUTTON:PALETTE 0,0,NZF 1510 ON CMDV+1 GOSUB *LOOP_RET,*ABOUT,*EXIT,*LOAD,*SAVE,*DOT_MODE,*LINE_MODE,*FREE_MODE,*PAINT_MODE,*ERASER,*COLOR,*CLS,*SPFLG,*PALFLG,*PENSIZE,*BOX,*BOX_FILL,*PENPATTERN,*COLORPEN,*COLORPEN2,*EFFECT,*STAMP,*WREFLG,*UNDO,*TEXT,*SNDFVFLG,*BOW 1520 *LOOP_RET:GOSUB *COLDISP:GOTO *EVENT_LOOP 1600 *CHECK_BUTTON:OCMDV=CMDV:OSTF=STF:CMDV=0:C=0:MX=MX-MENX:IF BWF=1 THEN LINE (BCX0+MENX,BCY0)-(BCX1+MENX,BCY1),XOR,7,BF:BWF=0 1610 FOR A=0 TO CMDN-1 1620 IF BUT%(A,0)=<MX AND BUT%(A,1)=<MY AND BUT%(A,2)=>MX AND BUT%(A,3)=>MY THEN CMDV=BV%(A,0):C=A:A=CMDN:STF=0 1630 NEXT:IF CMDV<>0 AND (BV%(C,1) AND 3)=1 THEN LINE (BUT%(C,0)+MENX,BUT%(C,1))-(BUT%(C,2)+MENX,BUT%(C,3)),XOR,7,BF:BCX0=BUT%(C,0):BCY0=BUT%(C,1):BCX1=BUT%(C,2):BCY1=BUT%(C,3):CMDFLG=C:BWF=1:MML$="@76V8O3T240d8&c8":GOSUB *PLAY 1640 IF CMDV<>0 AND (BV%(C,1) AND 3)<>1 THEN LINE (BCX0+MENX,BCY0)-(BCX1+MENX,BCY1),XOR,7,BF:BWF=1 1650 RETURN 1700 *MENUCHK 1710 MX=MOUSE(0):IF MENX=0 THEN 1730 1720 IF 480>MX THEN YN=0:RETURN ELSE YN=1:RETURN 1730 IF 160<MX THEN YN=0:RETURN ELSE YN=1:RETURN 2000 *EXIT:MML$="@1V8O0T120C8C8":MML1$="@1V8O2T120C8C8":GOSUB *PCM 2010 GET@A (0,0)-(639,511),GB%:GOSUB *ERR_GET_PIC:ERRV=0:M$="AmazingPAINTを終了します":GOSUB *TORIJIK:IF YN=0 THEN MML$="@1V8O2T120C1":GOSUB *PCM:GOSUB *UNDOCMD:RETURN ELSE MML$="@1V8O3T120C1":GOSUB *PCM:WAIT 200:END 2300 *VW0:VIEW (0,0)-(1023,511):WINDOW (0,0)-(1023,511):RETURN 2310 *VW1:VIEW (0,0)-(1023,479):WINDOW (0,0)-(1023,479):RETURN 2320 *VW2:VIEW (0,0)-(639,511):WINDOW (0,0)-(639,511):RETURN 2330 *VW3:VIEW (0,0)-(639,479):WINDOW (0,0)-(639,479):RETURN 2400 *UNDO:GOSUB *MENUOFF:MML$="T240@72V4O4C1C1.":GOSUB *PLAY:WHILE PLAY(0):WEND 2410 OUT &HFDA0,0:GOSUB *EXCHG_BUF:MML$="T240R8@76V4O2b8@75V15O5b1":GOSUB *PLAY:WAIT 20:OUT &HFDA0,12:GOSUB *MENUWRT:GOSUB *UNDOCMD:RETURN 2450 *UNDOGET:GOSUB *MENUOFF:GET@A (0,0)-(639,479),GB%:RETURN 2500 *LOAD:GOSUB *UNDOGET:GOSUB *FILELOAD:GOSUB *MENUWRT:GOSUB *UNDOCMD:RETURN 2600 *SAVE:GOSUB *UNDOGET:GOSUB *FILESAVE:GOSUB *MENUWRT:GOSUB *UNDOCMD:RETURN 3000 *DOT_MODE:GOSUB *UNDOGET:MML$="@60T240V8O2":GOSUB *PLAY 3010 *DOT_MODEIN:GOSUB *MOS_WAIT:MOUSE 1,,,0:WHILE MOUSE(6,0)=0:GOSUB *WRTDOT:GOSUB *PAL_SHIFT:WEND 3020 GOSUB *MENUWRT:RETURN 3500 *LINE_MODE:OWREF=0:SWAP OWREF,WREF:GOSUB *UNDOGET:MML$="@59T240V8O2":GOSUB *PLAY 3510 GOSUB *MOS_WAIT:WHILE MOUSE(6,0)=0:GOSUB *PAL_SHIFT:WEND:GOSUB *WRTDOT2:GOSUB *WRT_LINE 3520 GOSUB *MENUWRT:SWAP OWREF,WREF:RETURN 3600 *WRT_LINE 3610 GOSUB *MOS_WAIT:WHILE MOUSE(6,0)=0:GOSUB *PAL_SHIFT:WEND:A=MOUSE(3,0):GOSUB *WRTLINE:WAIT 30:IF MOUSE(3,0)=0 THEN *WRT_LINE ELSE IF MX<>MOUSE(0) OR MY<>MOUSE(1) THEN *WRT_LINE ELSE WHILE MOUSE(6,0)=0:WEND 3620 RETURN 4000 *FREE_MODE:GOSUB *UNDOGET:MML$="@71T240V1O2":GOSUB *PLAY 4010 GOSUB *MOS_WAIT:MOUSE 1,,,0:GOSUB *WRTDOT2:WHILE MOUSE(6,0)=0:GOSUB *WRTLINE:GOSUB *PAL_SHIFT:WEND 4020 GOSUB *MENUWRT:RETURN 4500 *PAINT_MODE:GOSUB *UNDOGET 4510 GOSUB *MOS_WAIT:WHILE MOUSE(6,0)=0:GOSUB *PAL_SHIFT:WEND:MX=MOUSE(0):MY=MOUSE(1):MML$="@2V15O5L1T120G":GOSUB *PCM:PAINT@ (MX,MY),%COLV:IF SP=1 THEN MOUSE 1,,,0:GOSUB *SP_PM:MOUSE 1,,,1 4520 *PMRET:MML$="@4V8O4T120C8R8":GOSUB *PCM:WHILE PLAY(0):WEND:PLAY OFF 4530 GOSUB *MENUWRT:RETURN 4600 *SP_PM:GOSUB *GET_MASK:IF A&=0 THEN RETURN ELSE AH=&HA:AL=0:GOSUB *EGB:AH=&HC:EDX&=&H22:GOSUB *EGB:AH=&HF:ESI&=VARPTR(OMS%(0)):GOSUB *EGB:AH=&H10:AL=&H81:GOSUB *EGB:AH=&H12:AL=1:GOSUB *EGB 4610 PARA%(0)=2:PARA%(1)=0:PARA%(2)=0:PARA%(3)=639:PARA%(4)=479:ESI&=VARPTR(PARA%(0)):A&=CALLM(OFFSET&,8):IF (A& AND 16) THEN *PMRAIN 4620 IF (A& AND 4) THEN *YOKOPM 4630 *TATEPM:FOR A=0 TO 479:AH=7:AL=0:EDX&=COLV:GOSUB *EGB:GOSUB *SP_SHIFT:PARA%(2)=A:PARA%(4)=A:AH=&H41:GOSUB *EGB:NEXT:RETURN 4650 *YOKOPM:FOR A=0 TO 639:AH=7:AL=0:EDX&=COLV:GOSUB *EGB:GOSUB *SP_SHIFT:PARA%(1)=A:PARA%(3)=A:AH=&H41:GOSUB *EGB:NEXT:RETURN 4700 *PMRAIN 4710 GC=0:RC=224:BC=224 4740 IF (A& AND 20)=20 THEN *RAINYOKO 4800 *RAINTATE:FOR A=0 TO 479:GOSUB *RAINSHIFT:PARA%(2)=A:PARA%(4)=A:AH=&H41:GOSUB *EGB:NEXT:RETURN 4810 *RAINYOKO:FOR A=0 TO 639:GOSUB *RAINSHIFT:PARA%(1)=A:PARA%(3)=A:AH=&H41:GOSUB *EGB:NEXT:RETURN 4900 *GET_MASK:A&=0:FOR A=0 TO 479:A&=A&+CALLM(OFFSET&,26,&H14,VARPTR(GB%(0))+640*A,&H128,1024*A,640,VARPTR(OMS%(0))+128*A):NEXT:RETURN 4950 *RAINSHIFT:AH=8:AL=0:ST=(A MOD 56)\7 4960 GC=GC+BOW%(0,ST)*32:RC=RC+BOW%(1,ST)*32:BC=BC+BOW%(2,ST)*32 4990 EDX&=GC*65536+RC*256+BC:GOSUB *EGB:RETURN 5000 *ERASER:PLAY OFF:OCOLV=255:SWAP OCOLV,COLV:OSP=0:SWAP OSP,SP:GOSUB *UNDOGET:MML$="@6T80L1V7O4CCCCCCC":GOSUB *PCM 5010 PCM=1:GOSUB *DOT_MODEIN:PCM=0:MML$="@4V8O4T120C8R8":GOSUB *PCM:WHILE PLAY(0):WEND:PLAY OFF:COLV=OCOLV:SP=OSP 5020 RETURN 5500 *COLOR:GOSUB *COL_MENU 5510 GOSUB *MOS_WAIT 5520 WHILE MOUSE(6,0)=0:MX=MOUSE(0):MY=MOUSE(1):GOSUB *COL_SET:WEND 5530 GOSUB *COLDISP:GOSUB *UNDOCMD:RETURN 5600 *COL_SET 5610 GET@A (MX,MY)-(MX,MY),GC%:COLV=GC%(0):GOSUB *COLDISP2 5620 RETURN 5700 *COL_MENU 5710 PUT@A (MENX+6,367)-(MENX+151,448),CM% 5720 RETURN 6000 *CLS:GOSUB *MENUOFF 6010 MFLG=0:WHILE MFLG=0:GOSUB *PAL_SHIFT:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2):WEND:IF (MFLG AND 2)=0 THEN WHILE MOUSE(6,0)=0:GOSUB *PAL_SHIFT:WEND ELSE WHILE MOUSE(6,1)=0:GOSUB *PAL_SHIFT:WEND:GOTO *CLS_SKP 6020 GET@A (0,0)-(639,479),GB%:IF SNDFV=1 THEN FOR A=0 TO 99:PLAY "@76V6O7L64T280BBBB":WHILE PLAY(0):WEND:NEXT 6030 MML$="@3V15O4L32T120C4&C&V12C&V10":GOSUB *PCM:FOR B=0 TO 3:GOSUB *BOMBDISP:NEXT:LINE (0,0)-(1023,511),PSET,%255,BF:WHILE PLAY(0):GOSUB *BOMBDISP:WEND 6040 *CLS_SKP:GOSUB *MENUWRT:GOSUB *UNDOCMD:RETURN 6100 *BOMBDISP:FOR A=0 TO 15:OUT &H440,27:OUT &H442,A+A*16+A*256+A*4096,2:NEXT:FOR A=15 TO 0 STEP -1:OUT &H440,27:OUT &H442,A+A*16+A*256+A*4096,2:NEXT:OUT &H440,27:OUT &H442,0,2:RETURN 6400 MML$="@5V6O4T240C2C2":GOSUB *PCMT 6500 *PENSIZE:OCOLV=255:MML$="@75V6O7T240d1":MML1$="@36V6O7T280r32e8":GOSUB *PLAY:SWAP OCOLV,COLV:GOSUB *COLDISP 6510 PUT@ (7+MENX,368)-(150+MENX,470),PSP%,PSET,0 6520 *PS_LOOP:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0)-MENX:MY=MOUSE(1) 6530 IF (MX-8) MOD 18>15 THEN *PS_LOOP 6540 IF (MY-384) MOD 18>15 THEN *PS_LOOP 6550 MX=(MX-7) \ 18:MY=(MY-384) \ 18:IF MX<0 OR MX>7 OR MY<0 OR MY>3 THEN *PS_LOOP 6560 LINE (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),XOR,7,BF:GET@ (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),PP%,%255:PS=MY*4+(MX\2)+1:DOF=PS\2:MDV=DOF+1 6570 MML$="@5V6O4T240C2C2":GOSUB *PCM:GOSUB *COLDISP:GOSUB *UNDOCMD:PCF=0:RETURN 6600 *PENPATTERN:OCOLV=255:MML$="@75V6O7T240d1":MML1$="@36V6O7T280r32e8":GOSUB *PLAY:SWAP OCOLV,COLV:GOSUB *COLDISP 6610 PUT@ (7+MENX,368)-(150+MENX,470),HSP%,PSET,0 6620 *PP_LOOP:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0)-MENX:MY=MOUSE(1) 6630 IF (MX-8) MOD 18>15 THEN *PP_LOOP 6640 IF (MY-384) MOD 18>15 THEN *PP_LOOP 6650 MX=(MX-7) \ 18:MY=(MY-384) \ 18:IF MX<0 OR MX>7 OR MY<0 OR MY>3 THEN *PP_LOOP 6660 LINE (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),XOR,7,BF:GET@ (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),PP%,%255:PS=16:DOF=PS\2:MDV=DOF+1 6670 MML$="@5V6O4T240C2C2":GOSUB *PCM:GOSUB *COLDISP:GOSUB *UNDOCMD:PCF=0:RETURN 6700 *COLORPEN:OCOLV=255:MML$="@75V6O7T240d1":MML1$="@36V6O7T280r32e8":GOSUB *PLAY:SWAP OCOLV,COLV:GOSUB *COLDISP 6710 PUT@A (7+MENX,368)-(150+MENX,470),PSP2% 6720 *PSC_LOOP:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0)-MENX:MY=MOUSE(1) 6730 IF (MX-8) MOD 18>15 THEN *PSC_LOOP 6740 IF (MY-384) MOD 18>15 THEN *PSC_LOOP 6750 MX=(MX-7) \ 18:MY=(MY-384) \ 18:IF MX<0 OR MX>7 OR MY<0 OR MY>3 THEN *PSC_LOOP 6760 GET@A (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),PPC%:LINE (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),XOR,7,BF:PS=16:DOF=PS\2:MDV=DOF+1 6770 MML$="@5V6O4T240C2C2":GOSUB *PCM:GOSUB *COLDISP:GOSUB *UNDOCMD:PCF=1:RETURN 6800 *COLORPEN2:OCOLV=255:MML$="@75V6O7T240d1":MML1$="@36V6O7T280r32e8":GOSUB *PLAY:SWAP OCOLV,COLV:GOSUB *COLDISP 6810 PUT@A (7+MENX,368)-(150+MENX,470),PSP3% 6820 *PC2_LOOP:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0)-MENX:MY=MOUSE(1) 6830 IF (MX-8) MOD 18>15 THEN *PC2_LOOP 6840 IF (MY-384) MOD 18>15 THEN *PC2_LOOP 6850 MX=(MX-7) \ 18:MY=(MY-384) \ 18:IF MX<0 OR MX>7 OR MY<0 OR MY>3 THEN *PC2_LOOP 6860 GET@A (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),PPC%:LINE (MX*18+MENX+8,MY*18+384)-(MX*18+MENX+23,MY*18+399),XOR,7,BF:PS=16:DOF=PS\2:MDV=DOF+1 6870 MML$="@5V6O4T240C2C2":GOSUB *PCM:GOSUB *COLDISP:GOSUB *UNDOCMD:PCF=1:RETURN 7000 *BOX:GOSUB *UNDOGET:MML$="@73T240V4O2":GOSUB *PLAY 7010 GOSUB *BOX_WRT:IF PS<2 AND SP=0 THEN LINE (MX0,MY0)-(MX,MY),PSET,%COLV,B ELSE GOSUB *BOX_DRAW 7020 GOSUB *MENUWRT:RETURN 7050 *BOX_FILL:GOSUB *UNDOGET:MML$="@73T240V4O2":GOSUB *PLAY 7060 GOSUB *BOX_WRT:IF SP=0 THEN LINE (MX0,MY0)-(MX,MY),PSET,%COLV,BF ELSE GOSUB *SP_FILL 7070 IF PS>1 AND SP<>0 THEN GOSUB *BOX_DRAW 7080 GOSUB *MENUWRT:RETURN 7100 *BOX_WRT 7110 GOSUB *MOS_WAIT:MOUSE 1,,,0:MX0=MOUSE(0):MY0=MOUSE(1):MX=MX0:MY=MY0 7120 WHILE MOUSE(6,0)=0 7130 OMX=MX:OMY=MY:MX=MOUSE(0):MY=MOUSE(1):IF MX<>OMX OR MY<>OMY THEN LINE (MX0,MY0)-(OMX,OMY),XOR,7,B:LINE (MX0,MY0)-(MX,MY),XOR,7,B 7140 WEND 7150 LINE (MX0,MY0)-(MX,MY),XOR,7,B:RETURN 7190 *SP_FILL:A&=CALLM(OFFSET&,8):IF (A& AND 20)=4 THEN *SP_FILL_X 7200 IF (A& AND 20)=16 THEN *SP_FILL_SP ELSE IF (A& AND 20)=20 THEN *SP_FILL_SP_XOR 7210 IF MY<MY0 THEN LSTP=-1 ELSE LSTP=1 7220 FOR Y=MY0 TO MY STEP LSTP 7230 LINE (MX0,Y)-(MX,Y),PSET,%COLV:GOSUB *SP_SHIFT 7240 NEXT:RETURN 7250 *SP_FILL_X 7260 IF MX<MX0 THEN LSTP=-1 ELSE LSTP=1 7270 FOR X=MX0 TO MX STEP LSTP 7280 LINE (X,MY0)-(X,MY),PSET,%COLV:GOSUB *SP_SHIFT 7290 NEXT:RETURN 7300 *SP_FILL_SP 7310 IF MX<MX0 THEN SWAP MX,MX0 7320 FOR X=0 TO MX-MX0:LINE (MX0+X,MY0)-(MX-X,MY),PSET,%COLV:GOSUB *SP_SHIFT:NEXT 7330 IF MY<MY0 THEN SWAP MY,MY0 7340 FOR Y=0 TO MY-MY0:LINE (MX0,MY0+Y)-(MX,MY-Y),PSET,%COLV:GOSUB *SP_SHIFT:NEXT:RETURN 7350 *SP_SHIFT:COLV=COLV+1:IF COLV>255 THEN COLV=0 7360 RETURN 7400 *SP_FILL_SP_XOR 7410 IF MX<MX0 THEN SWAP MX,MX0 7420 FOR X=0 TO MX-MX0:LINE (MX0+X,MY0)-(MX-X,MY),XOR,%COLV:GOSUB *SP_SHIFT:NEXT 7430 IF MY<MY0 THEN SWAP MY,MY0 7440 FOR Y=0 TO MY-MY0:LINE (MX0,MY0+Y)-(MX,MY-Y),XOR,%COLV:GOSUB *SP_SHIFT:NEXT:RETURN 7500 *BOX_DRAW 7510 LDX1=MX0:LDY1=MY0:LDX2=MX:LDY2=MY0:GOSUB *LINE_DRAW:LDX1=MX:LDY1=MY0:LDX2=MX:LDY2=MY:GOSUB *LINE_DRAW:LDX1=MX:LDY1=MY:LDX2=MX0:LDY2=MY:GOSUB *LINE_DRAW:LDX1=MX0:LDY1=MY:LDX2=MX0:LDY2=MY0:GOSUB *LINE_DRAW:RETURN 7600 *BOW:GOSUB *UNDOGET 7610 GOSUB *MOS_WAIT:X=MOUSE(6,0):MX0=MOUSE(0):MY0=MOUSE(1):MX=MX0:MY=MY0:MOUSE 1,,,0:MML$="@7V5O3L1T120FR8":MML1$="@7V15O3L1T120R8F":GOSUB *PCM 7620 WHILE MOUSE(6,0)=0 7630 OMX=MX:OMY=MY:MX=MOUSE(0):MY=MOUSE(1):IF MX<>OMX OR MY<>OMY THEN LINE (MX0,MY0)-(OMX,OMY),XOR,7:LINE (MX0,MY0)-(MX,MY),XOR,7 7640 WEND:MX1=MX:MY1=MY:WAIT 50:MOUSE 1,,,1:R!=SQR(((MX0-MX)^2)+((MY0-MY)^2)):GOSUB *CALD:SD!=TD!:LINE (MX0,MY0)-(MX,MY),XOR,7:MML1$="@4V8O4T120C8R8":GOSUB *PCM 7650 WHILE MOUSE(6,0)=0 7660 OMX=MX:OMY=MY:MX=MOUSE(0):MY=MOUSE(1):IF MX<>OMX OR MY<>OMY THEN LINE (MX0,MY0)-(OMX,OMY),XOR,7:LINE (MX0,MY0)-(MX,MY),XOR,7 7670 WEND:GOSUB *CALD:ED!=TD!:LINE (MX0,MY0)-(MX,MY),XOR,7:LINE (MX0,MY0)-(MX1,MY1),XOR,7:PSET (MX0,MY0),7,XOR:MML$="@4V8O4T120C8R8":GOSUB *PCM 7680 A&=CALLM(OFFSET&,8):MOUSE 1,,,0:ST=32:GC=0:RC=224:BC=224:IF (A& AND 4) THEN PW=2 ELSE PW=1 7690 PASTEL 96:DEF PEN 0,PW+1:MML$="@110T240V4O4":MML1$="@110T240V4O4":GOSUB *PLAY 7700 FOR A=0 TO 4:FOR B=0 TO 224/ST-1:MML$="C":MML1$="RE":GOSUB *PLAYNO 7710 IF (A& AND 16) THEN CIRCLE (MX0,MY0),R!,[GC,RC,BC],,SD!,ED!,,PASTEL ELSE CIRCLE (MX0,MY0),R!,[GC,RC,BC],,SD!,ED! 7720 GC=GC+BOW%(0,A)*ST:RC=RC+BOW%(1,A)*ST:BC=BC+BOW%(2,A)*ST:R!=R!+PW 7730 NEXT:NEXT:DEF PEN 0,1:MOUSE 1,,,1:PLAY OFF 7899 GOSUB *MENUWRT:RETURN 7900 *CALD:IF MY=MY0 AND MX<MX0 THEN TD=180 ELSE IF MX=MX0 THEN TD=90 ELSE TD=ATN((MY-MY0)/(MX-MX0))*180/3.14! 7910 IF TD<0 THEN TD=180+TD 7920 IF MY<MY0 THEN TD=TD+180 7930 TD!=TD/360:RETURN 7950 *DATSET:RESTORE *DATSET:FOR A=0 TO 7:FOR B=0 TO 2:READ BOW%(B,A):NEXT:NEXT:RETURN:DATA 0,-1,0, 1,0,0, 0,0,-1, 0,1,0, -1,0,0, 0,-1,0, 1,1,1, -1,0,0 8000 *PALFLG 8010 A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN GOSUB *PAL_INI:RETURN 8020 IF (A& AND 16)=16 THEN GOSUB *PAL_INI_ORG:RETURN 8030 FLG%=1:PALF=1-PALF:YN=PALF:GOSUB *FLGSW:RETURN 8100 *FLGSW 8110 IF YN=0 THEN PASTEL 180:LINE (MENX+BUT%(FLG%,0),BUT%(FLG%,1))-(MENX+BUT%(FLG%,2),BUT%(FLG%,3)),PASTEL,0,BF ELSE PUT@A (MENX+BUT%(FLG%,0),BUT%(FLG%,1))-(MENX+BUT%(FLG%,2),BUT%(FLG%,3)),FLG%,,,,,722*(FLG%-1) 8120 GOSUB *UNDOCMD:MML$="@32V8O4T160E16C16":GOSUB *PLAY:RETURN 8500 *SPFLG 8510 FLG%=2:SP=1-SP:YN=SP:GOSUB *FLGSW:RETURN 8600 *WREFLG 8610 FLG%=3:WREF=1-WREF:YN=WREF:GOSUB *FLGSW:RETURN 8700 *SNDFVFLG 8710 FLG%=4:SNDFV=1-SNDFV:YN=SNDFV:GOSUB *FLGSW:RETURN 9000 *LINE_DRAW 9010 IF LDX1=LDX2 AND LDY1=LDY2 THEN X=LDX1:Y=LDY1:GOSUB *PSET:RETURN 9020 LDDX=ABS(LDX2-LDX1):LDDY=ABS(LDY2-LDY1) 9030 IF (LDX1<LDX2)=(LDY1<LDY2) THEN LSTP=1 ELSE LSTP=-1 9040 IF NOT(LDDX>LDDY) THEN *LINEDRAW2 9050 IF LDX1>LDX2 THEN *LINEDRAW3 9060 IF LDX1>LDX2 THEN LDX1=LDX2:LDY1=LDY2 9070 X=LDX1:Y=LDY1:GOSUB *PSET:S=LDDX/2 9090 FOR I=LDX1+1 TO LDX1+LDDX 9110 S=S-LDDY:IF S<0 THEN S=S+LDDX:LDY1=LDY1+LSTP 9120 IF MDV=1 OR (I MOD MDV)=1 THEN X=I:Y=LDY1:GOSUB *PSET 9130 NEXT:GOTO *LINE_DRAW_END 9140 *LINEDRAW3 9150 IF LDX1<LDX2 THEN LDX2=LDX1:LDY1=LDY2 9160 X=LDX2+LDDX:Y=LDY1:GOSUB *PSET:S=LDDX/2 9180 FOR I=LDX2+LDDX TO LDX2+1 STEP -1 9200 S=S-LDDY:IF S<0 THEN S=S+LDDX:LDY1=LDY1-LSTP 9210 IF MDV=1 OR (I MOD MDV)=1 THEN X=I:Y=LDY1:GOSUB *PSET 9220 NEXT:GOTO *LINE_DRAW_END 9230 *LINEDRAW2 9240 IF LDY1>LDY2 THEN *LINEDRAW4 9250 IF LDY1>LDY2 THEN LDY1=LDY2:LDX1=LDX2 9260 X=LDX1:Y=LDY1:GOSUB *PSET:S=LDDY/2 9280 FOR I=LDY1+1 TO LDY1+LDDY 9300 S=S-LDDX:IF S<0 THEN S=S+LDDY:LDX1=LDX1+LSTP 9310 IF MDV=1 OR (I MOD MDV)=1 THEN X=LDX1:Y=I:GOSUB *PSET 9320 NEXT:GOTO *LINE_DRAW_END 9330 *LINEDRAW4 9340 IF LDY1<LDY2 THEN LDY2=LDY1:LDX1=LDX2 9350 X=LDX1:Y=LDY2+LDDY:GOSUB *PSET:S=LDDY/2 9370 FOR I=LDY2+LDDY TO LDY2+1 STEP -1 9390 S=S-LDDX:IF S<0 THEN S=S+LDDY:LDX1=LDX1-LSTP 9400 IF MDV=1 OR (I MOD MDV)=1 THEN X=LDX1:Y=I:GOSUB *PSET 9410 NEXT:GOTO *LINE_DRAW_END 9440 *LINE_DRAW_END:RETURN 10000 *EFFECT:OCOLV=255:MML$="@76V7O5T240b1":MML1$="@125V6O5T240b1":GOSUB *PLAY:SWAP OCOLV,COLV:GOSUB *COLDISP:EFS=8 10010 PUT@ (7+MENX,368)-(150+MENX,470),EF1%,PSET,0:EFM=1 10020 *EF_LOOP:GOSUB *PMENU_MOS:IF (MFLG AND 2)<>0 THEN *EF_RET ELSE MX=MOUSE(0)-MENX:MY=MOUSE(1) 10030 IF (MX-8) MOD 36>33 THEN *EF_LOOP 10040 IF (MY-384) MOD 36>33 THEN *EF_LOOP 10050 IF MY>470 THEN *EF_LOOP ELSE MX=(MX-7) \ 36:MY=(MY-384) \ 36:IF MX<0 OR MX>3 OR MY<0 OR MY>2 THEN *EF_LOOP 10060 IF MY=2 AND (MX=1 OR MX=2) THEN *EF_LOOP ELSE IF MY<>2 THEN *EF_SEL 10070 IF MX=0 THEN EFM=EFM-1:IF EFM<1 THEN EFM=EF 10080 IF MX=3 THEN EFM=EFM+1:IF EFM>EF THEN EFM=1 10090 GOSUB *COLDISP:MML$="@75V6O7T240d1":MML1$="@122V6O7T280r32e8":GOSUB *PLAY:ON EFM GOSUB *EF1_PUT,*EF2_PUT,*EF3_PUT,*EF4_PUT:GOTO *EF_LOOP 10100 *EF1_PUT:PUT@ (7+MENX,368)-(150+MENX,470),EF1%,PSET,0:RETURN 10110 *EF2_PUT:PUT@ (7+MENX,368)-(150+MENX,470),EF2%,PSET,0:RETURN 10120 *EF3_PUT:PUT@ (7+MENX,368)-(150+MENX,470),EF3%,PSET,0:RETURN 10130 *EF4_PUT:PUT@ (7+MENX,368)-(150+MENX,470),EF4%,PSET,0:RETURN 10140 *EF_SEL:MML$="@76V7O5T240b1":MML1$="@75V6O5T240b1":GOSUB *PLAY:LINE (MX*36+MENX+8,MY*36+384)-(MX*36+MENX+41,MY*36+417),XOR,7,BF:EFCMD=(EFM-1)*8+MY*4+MX:IF EFCMD=15 THEN GOSUB *MENUOFF ELSE GOSUB *UNDOGET 10150 MOUSE 1,,,0:SWAP OCOLV,COLV:GOSUB *VW3 10160 ON EFCMD+1 GOSUB *COPYH,*COPYV,*MIRRORV,*MIRRORH,*SYMM4,*SYMM9,*WALL,*POSTER,*XORR,*XORC,*XORV,*XORH,*SHIFTV,*SHIFTH,*SINWAVE,*PILE,*CEBIG,*CEBIG,*CEBIG,*CEBIG,*EFFG,*EFFG,*EFFG,*EFFG,*CAMERA,*CUTOUT,*CUTSHADOW,*ZOOM,*MOSAIC,*FACET,*PMETAL,*POST 10170 GOSUB *MENUWRT 10180 *EF_RET:GOSUB *VW0:MOUSE 1,,,1:GOSUB *COLDISP:GOSUB *UNDOCMD:RETURN 10500 *PMENU_MOS 10510 MFLG=0:WHILE MFLG=0:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2):WEND:IF (MFLG AND 2)=0 THEN WHILE MOUSE(6,0)=0:WEND ELSE WHILE MOUSE(6,1)=0:WEND 10520 RETURN 11000 *SHIFTV 11010 FOR X=0 TO (320/EFS)-1 11020 GET@A (X*EFS*2,480-EFS)-(X*EFS*2+EFS-1,479),ST%,19200:GET@A (X*EFS*2,0)-(X*EFS*2+EFS-1,479-EFS),ST%:PUT@A (X*EFS*2,0)-(X*EFS*2+EFS-1,EFS-1),ST%,,,,,19200:PUT@A (X*EFS*2,EFS)-(X*EFS*2+EFS-1,479),ST% 11030 GET@A (X*EFS*2+EFS,0)-(X*EFS*2+EFS*2-1,EFS-1),ST%,19200:GET@A (X*EFS*2+EFS,EFS)-(X*EFS*2+EFS*2-1,479),ST%:PUT@A (X*EFS*2+EFS,480-EFS)-(X*EFS*2+EFS*2-1,479),ST%,,,,,19200:PUT@A (X*EFS*2+EFS,0)-(X*EFS*2+EFS*2-1,479-EFS),ST% 11040 NEXT:RETURN 11050 *SHIFTH 11060 FOR Y=0 TO (240/EFS)-1 11070 GET@A (640-EFS,Y*EFS*2)-(639,Y*EFS*2+EFS-1),ST%,19200:GET@A (0,Y*EFS*2)-(639-EFS,Y*EFS*2+EFS-1),ST%:PUT@A (0,Y*EFS*2)-(EFS-1,Y*EFS*2+EFS-1),ST%,,,,,19200:PUT@A (EFS,Y*EFS*2)-(639,Y*EFS*2+EFS-1),ST% 11080 GET@A (0,Y*EFS*2+EFS)-(EFS-1,Y*EFS*2+EFS*2-1),ST%,19200:GET@A (EFS,Y*EFS*2+EFS)-(639,Y*EFS*2+EFS*2-1),ST%:PUT@A (640-EFS,Y*EFS*2+EFS)-(639,Y*EFS*2+EFS*2-1),ST%,,,,,19200:PUT@A (0,Y*EFS*2+EFS)-(639-EFS,Y*EFS*2+EFS*2-1),ST% 11090 NEXT:RETURN 11100 *MIRRORV 11110 FOR X=0 TO 319 11120 GET@A (X,0)-(X,479),ST%,19200:GET@A (639-X,0)-(639-X,479),ST%:PUT@A (X,0)-(X,479),ST%:PUT@A (639-X,0)-(639-X,479),ST%,,,,,19200 11130 NEXT:RETURN 11150 *MIRRORH 11160 FOR Y=0 TO 239 11170 GET@A (0,Y)-(639,Y),ST%,19200:GET@A (0,479-Y)-(639,479-Y),ST%:PUT@A (0,Y)-(639,Y),ST%:PUT@A (0,479-Y)-(639,479-Y),ST%,,,,,19200 11180 NEXT:RETURN 11200 *MOS_BOX:MX=MOUSE(6,0) 11210 IF MX0=640 AND MY0=480 THEN MX=0:MY=0:RETURN 11220 IF MX0=640 THEN MOUSE 4,0,0,0,(479-MY0):MOUSE 1,0,(MY0\2),0:GOTO *SKP_SET 11230 IF MY0=480 THEN MOUSE 4,0,0,(639-MX0),0:MOUSE 1,(MX0\2),0,0:GOTO *SKP_SET 11240 MOUSE 4,0,0,(639-MX0),(479-MY0):MOUSE 1,(MX0\2),(MY0\2),0 11250 *SKP_SET:MX=MOUSE(0):MY=MOUSE(1):LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),XOR,7,B:MFLG=0 11260 WHILE MFLG=0:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2) 11270 OMX=MX:OMY=MY:MX=MOUSE(0):MY=MOUSE(1):IF OMX<>MX OR OMY<>MY THEN LINE (OMX,OMY)-(OMX+MX0-1,OMY+MY0-1),XOR,7,B:LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),XOR,7,B 11280 WEND:IF (MFLG AND 1)=1 THEN WHILE MOUSE(6,0)=0:WEND:LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),XOR,7,B:MOUSE 4,0,0,639,479:RETURN 11290 WHILE MOUSE(6,1)=0:WEND:LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),XOR,7,B:MOUSE 4,0,0,639,479:RETURN *MOSBRET 11300 *MOSBRET:RETURN 11500 *SYMM4 11510 MX0=320:MY0=240:GOSUB *MOS_BOX:GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),ST%:PUT@A (0,0)-(MX0-1,MY0-1),ST% 11520 FOR X=0 TO 319:GET@A (X,0)-(X,239),ST%:PUT@A (639-X,0)-(639-X,239),ST%:NEXT 11530 FOR Y=0 TO 239:GET@A (0,Y)-(639,Y),ST%:PUT@A (0,479-Y)-(639,479-Y),ST%:NEXT:RETURN 11600 *SYMM9 11610 MX0=214:MY0=160:GOSUB *MOS_BOX:GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),ST%:PUT@A (0,0)-(MX0-1,MY0-1),ST% 11620 FOR X=0 TO 213:GET@A (X,0)-(X,159),ST%:PUT@A (427-X,0)-(427-X,159),ST%:NEXT:GET@A (0,0)-(211,159),ST%:PUT@A (428,0)-(639,159),ST% 11630 FOR Y=0 TO 159:GET@A (0,Y)-(639,Y),ST%:PUT@A (0,319-Y)-(639,319-Y),ST%:NEXT:GET@A (0,0)-(639,79),ST%:PUT@A (0,320)-(639,399),ST%:GET@A (0,80)-(639,159),ST%:PUT@A (0,400)-(639,479),ST%:RETURN 11700 *WALL 11710 GSV=2:GS=5:GS!(0)=4:GS!(1)=9:GS!(2)=16:GS!(3)=25:GS!(4)=36:GS!(5)=49:M$=" ＜分割数を設定＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5 11720 GOSUB *MOS_BOX:GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),ST% 11730 FOR X=0 TO SQR(GS!(GSV))-1:FOR Y=0 TO SQR(GS!(GSV))-1:PUT@A (X*MX0,Y*MY0)-(X*MX0+MX0-1,Y*MY0+MY0-1),ST%:NEXT:NEXT:RETURN 11740 *WAL0:MX0=320:MY0=240:RETURN 11750 *WAL1:MX0=214:MY0=160:RETURN 11760 *WAL2:MX0=160:MY0=120:RETURN 11770 *WAL3:MX0=128:MY0=96:RETURN 11780 *WAL4:MX0=107:MY0=80:RETURN 11790 *WAL5:MX0=92:MY0=69:RETURN 11800 *GETSIZE 11810 GOSUB *MENUWRT:MOUSE 1,,,1:LINE (7+MENX,384)-(150+MENX,455),PSET,0,BF,7:SYMBOL (MENX+45,456),"Set(決定)",.9!,1,0:LINE (MENX+43,455)-(MENX+113,471),PSET,0,B:SYMBOL (MENX+8,436),M$,1,1,0:GOTO *GS_PUT 11820 *GS_LOOP:MFLG=0:WHILE MFLG=0:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2):WEND:IF (MFLG AND 2)=2 THEN WHILE MOUSE(6,1)=0:WEND:RETURN *BASERET 11830 WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0):MY=MOUSE(1):IF MX<MENX+7 OR MX>MENX+150 OR MY<455 OR MY>470 THEN *GS_LOOP 11840 MX=MX-MENX:IF MX<43 THEN GSV=GSV-1:IF GSV<0 THEN GSV=GS 11850 IF MX>113 THEN GSV=GSV+1:IF GSV>GS THEN GSV=0 11860 IF MX>42 AND MX<114 THEN *GS_LOOP_OUT 11870 *GS_PUT:MML$="@75V6O7T240d1":MML1$="@122V6O7T280r32e8":GOSUB *PLAY:LINE (MENX+26,386)-(MENX+131,434),PSET,0,BF,7 11880 IF LEN(STR$(GS!(GSV)))>4 THEN SYMBOL (MENX+37,388),RIGHT$(" "+STR$(GS!(GSV)),4),2,3,0,,,3 ELSE SYMBOL (MENX+37,388),RIGHT$(" "+STR$(GS!(GSV)),3),3,3,0,,,3 11890 GOTO *GS_LOOP 11900 *GS_LOOP_OUT:MML$="@57V7O5T240b1":MML1$="@41V6O5T240b1":GOSUB *PLAY:MOUSE 1,,,0:GOSUB *UNDOGET:RETURN 11910 *BASERET:MOUSE 1,,,0:GOSUB *MENUOFF:RETURN 12000 *SINWAVE 12010 GSV=9:GS=32:FOR A=1 TO 33:GS!(A-1)=A*5:NEXT:M$=" ＜波の大きさ＞":GOSUB *GETSIZE:MY0=GS!(GSV):MX0=1 12020 FOR X=0 TO 639 STEP MX0:Y=SIN(3.14!*X/180)*MY0+MY0 12030 GET@A (X,480-Y)-(X+MX0-1,479),ST%,19200:GET@A (X,0)-(X+MX0-1,479-Y),ST%:PUT@A (X,0)-(X+MX0-1,Y-1),ST%,,,,,19200:PUT@A (X,Y)-(X+MX0-1,479),ST% 12040 NEXT:RETURN 12100 *XORR 12110 GOSUB *OBI:IF (MFLG AND 2)=2 THEN RETURN ELSE MY0=GS!(GSV):GOSUB *VW3 12120 FOR Y=479 TO 240+MY0 STEP -MY0 12130 LINE (479-Y,479-Y)-(Y+160,Y),XOR,%COLV,BF:IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=1 12140 NEXT:RETURN 12190 *OBI:GSV=9:GS=32:FOR A=1 TO 33:GS!(A-1)=A:NEXT:M$=" ＜帯の幅＞":GOSUB *GETSIZE:RETURN 12200 *XORC 12210 GOSUB *OBI:IF (MFLG AND 2)=2 THEN RETURN ELSE MX0=GS!(GSV):GOSUB *VW3 12220 FOR X=MX0 TO 420 STEP MX0 12230 CIRCLE (320,240),X,%COLV,,,,F,XOR:IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=1 12240 NEXT:RETURN 12300 *XORV 12310 GOSUB *OBI:IF (MFLG AND 2)=2 THEN RETURN ELSE MX0=GS!(GSV):GOSUB *VW3 12320 FOR X=0 TO 639 STEP MX0*2 12330 LINE (X,0)-(X+MX0-1,479),XOR,%COLV,BF:IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=1 12340 NEXT:RETURN 12400 *XORH 12410 GOSUB *OBI:IF (MFLG AND 2)=2 THEN RETURN ELSE MY0=GS!(GSV):GOSUB *VW3 12420 FOR Y=0 TO 479 STEP MY0*2 12430 LINE (0,Y)-(639,Y+MY0-1),XOR,%COLV,BF:IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=1 12440 NEXT:RETURN 12450 *CEBIG:EFCMD=EFCMD-16:GSV=1:GS=1:GS!(0)=1:GS!(1)=4:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:IF GSV=0 THEN MM=28:MX0=640:MY0=480 ELSE MM=20:MX0=320:MY0=240 12460 ON EFCMD+1 GOSUB *CENTERBIGV,*CENTERBIGH,*EDGEBIGV,*EDGEBIGH 12470 *SETCBIG:GS!(0)=0:GS!(1)=1:GS!(2)=2:GS!(3)=3:GS!(4)=4:GS!(5)=4:GS!(6)=5:GS!(7)=5:GS!(8)=5:GS!(9)=6:GS!(10)=6:GS!(11)=6:GS!(12)=7:GS!(13)=7:GS!(14)=7:GS!(15)=7:GS!(16)=8:GS!(17)=8:GS!(18)=8:GS!(19)=9:GS!(20)=9:GS!(21)=9:GS!(22)=10 12475 GS!(23)=10:GS!(24)=10:GS!(25)=11:GS!(26)=11:GS!(27)=11:GS!(28)=11:RETURN 12480 *SETEBIG:GS!(28)=0:GS!(27)=0:GS!(26)=0:GS!(25)=0:GS!(24)=0:GS!(23)=0:GS!(22)=0:GS!(21)=0 12485 GS!(20)=0:GS!(19)=0:GS!(18)=0:GS!(17)=0:GS!(16)=1:GS!(15)=1:GS!(14)=2:GS!(13)=2:GS!(12)=3:GS!(11)=3:GS!(10)=4:GS!(9)=4:GS!(8)=4:GS!(7)=5:GS!(6)=5:GS!(5)=6:GS!(4)=7:GS!(3)=8:GS!(2)=9:GS!(1)=10:GS!(0)=11:RETURN 12490 *SETEBIG2:GOSUB *SETEBIG:FOR A=0 TO MM-5:GS!(A)=GS!(A+5):NEXT:RETURN 12500 *CENTERBIGV:GOSUB *SETCBIG:GOTO *BIGV 12510 *EDGEBIGV:GOSUB *SETEBIG:GOTO *BIGV 12520 *BIGV:GOSUB *MOS_BOX:X=(MX0\2)-1:MX0=MX+MX0-1:MY0=MY+MY0-1:A=MM:LDY=MY:YL0=MY0 12530 WHILE X>-1:MM=GS!(A):IF INKEY$=CHR$(27) THEN X=0:GOTO *BVLOP 12540 IF MX+X-MM<MX THEN MM0=X ELSE MM0=MM 12550 LDX=MX+MM0:XL0=MX+X:GOSUB *GETBIGY:LDX=MX:XL0=MX+X-MM0:GOSUB *PUTBIGY 12560 IF MX0-X+MM>MX0 THEN MM0=X ELSE MM0=MM 12570 LDX=MX0-MM0:XL0=MX0-X:GOSUB *GETBIGY:LDX=MX0-X+MM0:XL0=MX0:GOSUB *PUTBIGY 12580 WHILE MM>0 12590 IF MX+X-1=>MX THEN GET@A (MX+X,MY)-(MX+X,MY0),ST%:PUT@A (MX+X-1,MY)-(MX+X-1,MY0),ST% 12600 IF MX0+1-X<=MX0 THEN GET@A (MX0-X,MY)-(MX0-X,MY0),ST%:PUT@A (MX0+1-X,MY)-(MX0+1-X,MY0),ST% 12610 X=X-1:MM=MM-1:WEND:X=X-1:A=A-1:IF A<0 THEN A=0 12620 *BVLOP:WEND:RETURN 12700 *CENTERBIGH:GOSUB *SETCBIG:GOTO *BIGH 12710 *EDGEBIGH:GOSUB *SETEBIG2:GOTO *BIGH 12720 *BIGH:GOSUB *MOS_BOX:Y=(MY0\2)-1:MX0=MX+MX0-1:MY0=MY+MY0-1:A=MM:LDX=MX:XL0=MX0 12730 WHILE Y>-1:MM=GS!(A):IF INKEY$=CHR$(27) THEN Y=0:GOTO *BHLOP 12740 IF MY+Y-MM<MY THEN MM0=Y ELSE MM0=MM 12750 LDY=MY+MM0:YL0=MY+Y:GOSUB *GETBIGX:LDY=MY:YL0=MY+Y-MM0:GOSUB *PUTBIGX 12760 IF MY0-Y+MM>MY0 THEN MM0=Y ELSE MM0=MM 12770 LDY=MY0-MM0:YL0=MY0-Y:GOSUB *GETBIGX:LDY=MY0-Y+MM0:YL0=MY0:GOSUB *PUTBIGX 12780 WHILE MM>0 12790 IF MY+Y-1=>MY THEN GET@A (MX,MY+Y)-(MX0,MY+Y),ST%:PUT@A (MX,MY+Y-1)-(MX0,MY+Y-1),ST% 12800 IF MY0+1-Y<=MY0 THEN GET@A (MX,MY0-Y)-(MX0,MY0-Y),ST%:PUT@A (MX,MY0+1-Y)-(MX0,MY0+1-Y),ST% 12810 Y=Y-1:MM=MM-1:WEND:Y=Y-1:A=A-1:IF A<0 THEN A=0 12820 *BHLOP:WEND:RETURN 12830 *GETBIGX:XX=(XL0-LDX)/2:GET@A (LDX,LDY)-(LDX+XX-1,YL0),ST%:GET@A (LDX+XX,LDY)-(XL0,YL0),MGB%:RETURN 12840 *GETBIGY:YY=(YL0-LDY)/2:GET@A (LDX,LDY)-(XL0,LDY+YY-1),ST%:GET@A (LDX,LDY+YY)-(XL0,YL0),MGB%:RETURN 12850 *PUTBIGX:XX=(XL0-LDX)/2:PUT@A (LDX,LDY)-(LDX+XX-1,YL0),ST%:PUT@A (LDX+XX,LDY)-(XL0,YL0),MGB%:RETURN 12860 *PUTBIGY:YY=(YL0-LDY)/2:PUT@A (LDX,LDY)-(XL0,LDY+YY-1),ST%:PUT@A (LDX,LDY+YY)-(XL0,YL0),MGB%:RETURN 12900 *POSTER 12910 GSV=2:GS=5:GS!(0)=4:GS!(1)=9:GS!(2)=16:GS!(3)=25:GS!(4)=36:GS!(5)=49:M$=" ＜分割数を設定＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5 12920 GOSUB *MOS_BOX:GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),ST% 12930 FOR X=0 TO SQR(GS!(GSV))-1:FOR Y=0 TO SQR(GS!(GSV))-1:PUT@A (X*MX0,Y*MY0)-(X*MX0+MX0-1,Y*MY0+MY0-1),ST%:LINE (X*MX0,Y*MY0)-(X*MX0+MX0-1,Y*MY0+MY0-1),PSET,0,B:NEXT:NEXT 12940 X=(640-MX0)\2:Y=(480-MY0)\2:PASTEL 128:LINE (X+8,Y+8)-(X+MX0+7,Y+MY0+7),PASTEL,0,BF:PUT@A (X-4,Y-4)-(X+MX0-5,Y+MY0-5),ST%:LINE (X-4,Y-4)-(X+MX0-5,Y+MY0-5),PSET,0,B:RETURN 14000 *COPYV 14010 FOR X=0 TO 319 14020 GET@A (X,0)-(X,479),ST%:PUT@A (639-X,0)-(639-X,479),ST% 14030 NEXT:RETURN 14050 *COPYH 14060 FOR Y=0 TO 239 14070 GET@A (0,Y)-(639,Y),ST%:PUT@A (0,479-Y)-(639,479-Y),ST% 14080 NEXT:RETURN 14100 *POST 14110 GSV=1:GS=5:GS!(0)=1:GS!(1)=4:GS!(2)=9:GS!(3)=16:GS!(4)=25:GS!(5)=36:GS!(6)=49:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *EFF0,*WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5 14120 EFFGF=0:GOSUB *MOS_BOX:A&=CALLM(OFFSET&,8):X=-9253 14130 IF (A& AND 4)=4 THEN X=-28014 14140 IF (A& AND 16)=16 THEN X=-18762 14150 IF (A& AND 20)=20 THEN X=28013 14160 IF GSV=0 THEN *POST_FULL 14170 GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),ST%:LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),PSET,7,BF 14180 GOSUB *POSTSET 14190 PUT@A (MX,MY)-(MX+MX0-1,MY+MY0-1),ST%:GOTO *POSTRET 14200 *POST_FULL 14210 FOR Y=0 TO 3:GOSUB *POSTRET:GET@A (0,Y*120)-(639,Y*120+119),ST%:LINE (0,Y*120)-(639,Y*120+119),PSET,7,BF:GOSUB *POSTSET:PUT@A (0,Y*120)-(639,Y*120+119),ST%:NEXT 14230 *POSTRET 14240 OUT &H458,0:OUT &H45A,-1,2:OUT &H458,1:OUT &H45A,-1,2:RETURN 14250 *POSTSET:OUT &H458,0:OUT &H45A,X,2:OUT &H458,1:OUT &H45A,X,2:RETURN 15000 *EFFG 15010 GSV=2:GS=5:GS!(0)=1:GS!(1)=4:GS!(2)=9:GS!(3)=16:GS!(4)=25:GS!(5)=36:GS!(6)=49:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *EFF0,*WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5 15020 EFFGF=0:GOSUB *MOS_BOX:LINE (MX,MY)-(MX+MX0-1,MY+MY0-1),XOR,6,B:LDX=MX:LDY=MY:XL0=LDX+MX0-1:YL0=LDY+MY0-1:A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 OR GSV=0 THEN EFFGF=1 15030 GOSUB *EFF0_MOS 15040 LINE (LDX,LDY)-(XL0,YL0),XOR,6,B:IF GSV=0 THEN GET@A (0,0)-(639,479),GB% ELSE GET@A (LDX,LDY)-(XL0,YL0),ST% 15050 IF EFFGF=1 THEN VIEW (LDX,LDY)-(XL0,YL0):WINDOW (LDX,LDY)-(XL0,YL0) ELSE GOSUB *VW3 15060 MX0=MAP(MX+MX0-1,0):MY0=MAP(MY+MY0-1,1):MX=MAP(MX,0):MY=MAP(MY,1):ON EFCMD-19 GOSUB *PASTELG,*XORG,*ANDG,*ORG:GOSUB *VW3:RETURN 15100 *EFF0:MX0=640:MY0=480:RETURN 15200 *EFF0_MOS 15210 MOUSE 1,320,240,0:MX=MOUSE(6,0) 15220 MX=MOUSE(0):MY=MOUSE(1):LINE (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),XOR,7,B 15230 WHILE MOUSE(2,0)=0 15240 OMX=MX:OMY=MY:MX=MOUSE(0):MY=MOUSE(1):IF OMX<>MX OR OMY<>MY THEN LINE (OMX-(MX0\2),OMY-(MY0\2))-(OMX+(MX0\2)-1,OMY+(MY0\2)-1),XOR,7,B:LINE (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),XOR,7,B 15250 WEND:WHILE MOUSE(6,0)=0:WEND:LINE (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),XOR,7,B:MX=MX-(MX0\2):MY=MY-(MY0\2):RETURN 15300 *PASTELG 15310 PASTEL 128:IF GSV=0 THEN PUT@A (MX,MY)-(MX0,MY0),GB%,PASTEL:RETURN ELSE PUT@A (MX,MY)-(MX0,MY0),ST%,PASTEL:RETURN 15350 *XORG 15360 IF GSV=0 THEN PUT@A (MX,MY)-(MX0,MY0),GB%,XOR:RETURN ELSE PUT@A (MX,MY)-(MX0,MY0),ST%,XOR:RETURN 15400 *ANDG 15410 IF GSV=0 THEN PUT@A (MX,MY)-(MX0,MY0),GB%,AND:RETURN ELSE PUT@A (MX,MY)-(MX0,MY0),ST%,AND:RETURN 15450 *ORG 15460 IF GSV=0 THEN PUT@A (MX,MY)-(MX0,MY0),GB%,OR:RETURN ELSE PUT@A (MX,MY)-(MX0,MY0),ST%,OR:RETURN 15500 *MOS_PAT:MX=MOUSE(6,0):GOSUB *VW3 15510 IF MX0=640 AND MY0=480 THEN MX=0:MY=0:RETURN 15520 MOUSE 4,0,0,639,479:MOUSE 1,(MX0\2),(MY0\2),0 15530 MX=MOUSE(0):MY=MOUSE(1):PUT@ (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),CUTP%,XOR,7:MFLG=0 15540 WHILE MFLG=0:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2) 15550 OMX=MX:OMY=MY:MX=MOUSE(0):MY=MOUSE(1):IF OMX<>MX OR OMY<>MY THEN PUT@ (OMX-(MX0\2),OMY-(MY0\2))-(OMX+(MX0\2)-1,OMY+(MY0\2)-1),CUTP%,XOR,7:PUT@ (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),CUTP%,XOR,7 15560 WEND:IF (MFLG AND 1)=1 THEN WHILE MOUSE(6,0)=0:WEND ELSE WHILE MOUSE(6,1)=0:WEND 15570 PUT@ (MX-(MX0\2),MY-(MY0\2))-(MX+(MX0\2)-1,MY+(MY0\2)-1),CUTP%,XOR,7:MOUSE 4,0,0,639,479:MX=MX-(MX0\2):MY=MY-(MY0\2):RETURN 15590 *CAM0:MX0=640:MY0=240:RETURN 16000 *CAMERA 16010 GSV=1:GS=5:GS!(0)=2:GS!(1)=4:GS!(2)=9:GS!(3)=16:GS!(4)=25:GS!(5)=36:GS!(6)=49:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *CAM0,*WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5 16020 GOSUB *MOS_BOX:CUTX=MX0:CUTY=MY0:CUTV=GSV 16050 GET@ (MX,MY)-(MX+MX0-1,MY+MY0-1),CUTP%,%COLV:RETURN 16100 *CUTOUT:A&=CALLM(OFFSET&,8):IF (A& AND 16)=16 THEN *CUT7 ELSE *CUT0 16110 *CUT7:MX0=CUTX:MY0=CUTY:GOSUB *MOS_PAT:IF (MFLG AND 2)=2 THEN RETURN 16120 A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN *CUTIN 16130 GET@A (0,0)-(639,479),GB%:LINE (0,0)-(639,479),PSET,7,BF:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0-1),CUTP%,PSET,0:PUT@A (0,0)-(639,479),GB%,OR:RETURN 16140 *CUTIN:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0),CUTP%,PSET,7:RETURN 16150 *CUT0 16160 MX0=CUTX:MY0=CUTY:GOSUB *MOS_PAT:IF (MFLG AND 2)=2 THEN RETURN 16170 A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN *CUT0IN 16180 GET@A (0,0)-(639,479),GB%:LINE (0,0)-(639,479),PSET,0,BF:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0-1),CUTP%,PSET,7:PUT@A (0,0)-(639,479),GB%,AND:RETURN 16190 *CUT0IN:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0),CUTP%,PSET,0:RETURN 16300 *CUTSHADOW 16310 MX0=CUTX:MY0=CUTY:GOSUB *MOS_PAT:IF (MFLG AND 2)=2 THEN RETURN ELSE PUT@ (MX,MY)-(MX+MX0-1,MY+MY0),CUTP%,XOR,6:LDX=MX:LDY=MY:GOSUB *MOS_PAT:PUT@ (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1),CUTP%,XOR,6:IF (MFLG AND 2)=2 THEN RETURN 16330 GET@A (0,0)-(639,479),GB%:LINE (0,0)-(639,479),PSET,0,BF:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0-1),CUTP%,PSET,7:PUT@A (0,0)-(639,479),GB%,AND:GOSUB *VW2:LINE (0,480)-(639,511),PSET,0,BF 16340 IF CUTV<>0 THEN GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),ST%:LINE (0,0)-(639,479),PSET,0,BF:PUT@A (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1),ST%:GOTO *SKP_SHADOW 16350 GET@A (MX,MY)-(MX+319,MY+MY0-1),ST%:GET@A (MX+320,MY)-(MX+631,MY+MY0-1),MGB%:LINE (0,0)-(639,479),PSET,0,BF:PUT@A (LDX,LDY)-(LDX+319,LDY+MY0-1),ST%:PUT@A (LDX+320,LDY)-(LDX+631,LDY+MY0-1),MGB% 16360 *SKP_SHADOW:GET@A (0,LDY)-(319,LDY+MY0-1),ST%:GET@A (320,LDY)-(639,LDY+MY0-1),MGB%:PUT@A (0,0)-(639,479),GB%:PUT@ (MX,MY)-(MX+MX0-1,MY+MY0-1),CUTP%,PSET,0:PUT@ (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1),CUTP%,PSET,0 16370 PUT@A (0,LDY)-(319,LDY+MY0-1),ST%,MATTE,,,0:PUT@A (320,LDY)-(639,LDY+MY0-1),MGB%,MATTE,,,0:A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN PASTEL 128:PUT@ (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1),CUTP%,PASTEL,7 16380 IF (A& AND 16)=16 THEN PASTEL 128:PUT@ (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1),CUTP%,PASTEL,0 16390 RETURN 16400 *EXCHG_BUF:GOSUB *VW0:GOSUB *EXCHG_BUFFER:GOSUB *VW3:RETURN 16410 *EXCHG_MATTE 16420 FOR A=0 TO 14:GET@A (0,A*32)-(639,A*32+31),ST%:PUT@A (0,480)-(639,511),ST%:PUT@A (0,A*32)-(639,A*32+31),GB%,PSET,,,,A*10240:GET@A (0,480)-(639,511),GB%,A*10240:NEXT:RETURN 16500 *ZOOM 16510 GSV=3:GS=6:GS!(0)=.125!:GS!(1)=.25!:GS!(2)=.5!:GS!(3)=2:GS!(4)=3:GS!(5)=4:GS!(6)=7:M$=" ＜ＺＯＯＭ倍率＞":GOSUB *GETSIZE:IF GS!(GSV)<1 THEN MX0=640:MY0=480 ELSE ON GSV-1 GOSUB *WAL0,*WAL1,*WAL2,*WAL3,*WAL4 16520 GOSUB *MOS_BOX:WFCMD=1:A&=CALLM(OFFSET&,8) 16530 IF GS!(GSV)<1 THEN *ZOOMOUT 16540 GET@A (MX,MY)-(MX+MX0-1,MY+MY0-1),ST%:IF (A& AND 16)<>16 THEN LINE (0,0)-(639,479),PSET,0,BF 16550 A=GS!(GSV):WFV=(640-MX0)\15:GSV=WFV*.75!:LDX=WFV*14:LDY=480-MY0:A!=(LDY-GSV)/TAN(3.14!*14*6/180):B!=(SQR(A)-1)/15:PUT@A (640-MX0,480-MY0-GSV)-(639,479-GSV),ST% 16560 FOR I=0 TO 14 16570 IF (A& AND 4)=4 AND (I AND 1)=1 THEN PASTEL 1:LINE (0,0)-(639,479),PASTEL,0,BF 16580 X=LDX-I*WFV:Y=FIX(TAN(3.14!*I*6/180)*-A!)+LDY-GSV 16590 PUT@A (X,Y)-(X+MX0-1,Y+MY0-1),ST%,PSET,B!*(I+1)+1,B!*(I+1)+1 16600 IF INKEY$=CHR$(27) THEN I=100 16610 NEXT:RETURN 16620 *ZOOMOUT:Y=0:A!=1:B!=(1-SQR(GS!(GSV)))/(10*(3-GSV)) 16630 FOR X=0 TO 240-GSV*80 STEP 8:Y=Y+6 16640 IF (A& AND 4)=4 THEN PASTEL 1:LINE (0,0)-(639,479),PASTEL,0,BF 16650 PUT@A (X,Y)-(X+639,Y+479),GB%,PSET,A!,A!:A!=A!-B! 16660 IF INKEY$=CHR$(27) THEN X=1000 16670 NEXT:RETURN 17000 *CAMGET:COLOR ,,7:GOSUB *VW1 17100 CLS:PRINT "AmazingPAINT is Painting Tool for Hobby Painters" 17110 PRINT " This Program Running on..." 17120 LOAD@ ".\CAMERA0.TIF",(0,120):WAIT 100 17130 CUTX=640:CUTY=240:CUTV=0:GET@ (0,60)-(639,299),CUTP%,7:RETURN 17500 *FACET 17510 WFV=1:WFCMD=1:GSV=2:GS=5:GS!(0)=1:GS!(1)=4:GS!(2)=9:GS!(3)=16:GS!(4)=25:GS!(5)=36:GS!(6)=49:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *EFF0,*WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5 17520 GSV=1:GS=3:GS!(0)=1:GS!(1)=2:GS!(2)=3:GS!(3)=4:M$=" ＜画素の大きさ＞":GOSUB *GETSIZE:WFV=GSV+1 17530 GOSUB *MOS_BOX:A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN IF (A& AND 16)=16 THEN WFCMD=3:CP=WFV*4*WFV-1 ELSE WFCMD=2 17540 LDX=MX:LDY=MY:GOSUB *FACET_WRT:RETURN 17600 *MOSAIC 17610 WFV=1:WFCMD=1:GSV=2:GS=5:GS!(0)=1:GS!(1)=4:GS!(2)=9:GS!(3)=16:GS!(4)=25:GS!(5)=36:GS!(6)=49:M$=" ＜画面1/Nサイズ＞":GOSUB *GETSIZE:ON GSV+1 GOSUB *EFF0,*WAL0,*WAL1,*WAL2,*WAL3,*WAL4,*WAL5 17620 GSV=6:GS=14:FOR A=0 TO 14:GS!(A)=A+2:NEXT:M$=" ＜画素の大きさ＞":GOSUB *GETSIZE:WFV=GSV+2 17630 GOSUB *MOS_BOX:A&=CALLM(OFFSET&,8):IF (A& AND 4)=4 THEN IF (A& AND 16)=16 THEN WFCMD=3:CP=WFV*WFV\4-1 ELSE WFCMD=2 17640 LDX=MX:LDY=MY:GOSUB *MOSAIC_WRT:RETURN 17800 *FACET_WRT:GOSUB *VW0 17810 FOR Y=LDY TO LDY+MY0-1 STEP 32*WFV 17820 FOR X=LDX TO LDX+MX0-1 STEP 32*WFV 17830 GOSUB *VW1:GET@A (X,Y)-(X+32*WFV-1,Y+32*WFV-1),WFP%:PUT@A (640,0)-(32*WFV+639,32*WFV-1),WFP% 17840 FOR YY=0 TO 7:FOR XX=0 TO 7 17850 GOSUB *VW1:GET@A (640+XX*4*WFV,YY*4*WFV)-(640+(XX+1)*4*WFV-1,(YY+1)*4*WFV-1),CP& 17860 GOSUB *WFCMD:A&=FRE(1):IF INKEY$=CHR$(27) THEN YY=7:XX=7:X=1000:Y=1000:GOTO *FACET_BREAK 17870 VIEW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1):WINDOW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1):DEF PEN 0,0:GOSUB *WRITEFACET 17880 *FACET_BREAK:NEXT:NEXT 17890 NEXT 17900 NEXT 17910 GOSUB *VW0:DEF PEN 0,1:RETURN 18000 *MOSAIC_WRT:GOSUB *VW0:VIEW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1):WINDOW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1):DEF PEN 0,0:LINE (X,Y)-(X+WFV-1,Y+WFV-1),PSET,0,BF 18010 FOR Y=LDY TO LDY+MY0-1 STEP WFV 18020 FOR X=LDX TO LDX+MX0-1 STEP WFV 18030 GOSUB *VW0:DEF PEN 0,1 18040 GET@A (X,Y)-(X+WFV-1,Y+WFV-1),CP& 18050 GOSUB *WFMCMD:A&=FRE(1):IF INKEY$=CHR$(27) THEN X=1000:Y=1000:GOTO *MOSAIC_BREAK 18060 VIEW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1):WINDOW (LDX,LDY)-(LDX+MX0-1,LDY+MY0-1) 18070 DEF PEN 0,0:LINE (X,Y)-(X+WFV-1,Y+WFV-1),PSET,0,BF,PP$ 18080 *MOSAIC_BREAK 18090 NEXT 18100 NEXT 18110 GOSUB *VW0:DEF PEN 0,1:RETURN 18160 *WRITEFACET:XXX=XX*4:YYY=YY*4 18170 ON XX+1 GOSUB *WFX0,*WFX1,*WFX2,*WFX3,*WFX4,*WFX5,*WFX6,*WFX7 18180 RETURN 18190 *WFX0:ON YY+1 GOTO *WFY00,*WFY01,*WFY02,*WFY03,*WFY04,*WFY05,*WFY06,*WFY07 18200 *WFY00:CONNECT (X+(XXX-1)*WFV,Y+(YYY+2)*WFV)-STEP(2*WFV,-3*WFV)-STEP(3*WFV,0)-STEP(0,5*WFV)-STEP(-5*WFV,-2*WFV),0,PSET,F,PP$:RETURN 18210 *WFY01:CONNECT (X+(XXX-1)*WFV,Y+(YYY-2)*WFV)-STEP(5*WFV,2*WFV)-STEP(-1*WFV,4*WFV)-STEP(-3*WFV,0)-STEP(-1*WFV,-6*WFV),0,PSET,F,PP$:RETURN 18220 *WFY02:CONNECT (X+(XXX-1)*WFV,Y+(YYY+1)*WFV)-STEP(1*WFV,-1*WFV)-STEP(3*WFV,0)-STEP(-1*WFV,4*WFV)-STEP(-2*WFV,0)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18230 *WFY03:CONNECT (X+(XXX-1)*WFV,Y+(YYY+4)*WFV)-STEP(1*WFV,-4*WFV)-STEP(5*WFV,0)-STEP(-2*WFV,3*WFV)-STEP(-4*WFV,1*WFV),0,PSET,F,PP$:RETURN 18240 *WFY04:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(4*WFV,-1*WFV)-STEP(1*WFV,4*WFV)-STEP(-4*WFV,1*WFV)-STEP(-1*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18250 *WFY05:CONNECT (X+(XXX-1)*WFV,Y+(YYY+3)*WFV)-STEP(1*WFV,-3*WFV)-STEP(4*WFV,-1*WFV)-STEP(-1*WFV,5*WFV)-STEP(-4*WFV,-1*WFV),0,PSET,F,PP$:RETURN 18260 *WFY06:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,1*WFV)-STEP(1*WFV,1*WFV)-STEP(0,3*WFV)-STEP(-3*WFV,0)-STEP(-1*WFV,-3*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN 18270 *WFY07:CONNECT (X+(XXX-1)*WFV,Y+(YYY+1)*WFV)-STEP(2*WFV,-1*WFV)-STEP(3*WFV,0)-STEP(0,3*WFV)-STEP(-3*WFV,0)-STEP(-2*WFV,-2*WFV),0,PSET,F,PP$:RETURN 18280 *WFX1:ON YY+1 GOTO *WFY10,*WFY11,*WFY12,*WFY13,*WFY14,*WFY15,*WFY16,*WFY17 18290 *WFY10:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,-1*WFV)-STEP(2*WFV,4*WFV)-STEP(-6*WFV,2*WFV)-STEP(0,-5*WFV),0,PSET,F,PP$:RETURN 18300 *WFY11:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(6*WFV,-2*WFV)-STEP(-2*WFV,5*WFV)-STEP(-2*WFV,2*WFV)-STEP(-3*WFV,-1*WFV)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18310 *WFY12:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,1*WFV)-STEP(2*WFV,3*WFV)-STEP(-6*WFV,0)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18320 *WFY13:CONNECT (X+(XXX-1)*WFV,Y+(YYY+3)*WFV)-STEP(2*WFV,-3*WFV)-STEP(3*WFV,0)-STEP(0,3*WFV)-STEP(-2*WFV,1*WFV)-STEP(-3*WFV,-1*WFV),0,PSET,F,PP$:RETURN 18330 *WFY14:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,1*WFV)-STEP(2*WFV,4*WFV)-STEP(-2*WFV,0)-STEP(-2*WFV,-1*WFV)-STEP(-1*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18340 *WFY15:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(2*WFV,1*WFV)-STEP(2*WFV,0)-STEP(-1*WFV,3*WFV)-STEP(-4*WFV,1*WFV)-STEP(1*WFV,-5*WFV),0,PSET,F,PP$:RETURN 18350 *WFY16:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(4*WFV,-1*WFV)-STEP(2*WFV,1*WFV)-STEP(-2*WFV,3*WFV)-STEP(-3*WFV,-2*WFV)-STEP(-1*WFV,-1*WFV),0,PSET,F,PP$:RETURN 18360 *WFY17:CONNECT (X+(XXX)*WFV,Y+(YYY-3)*WFV)-STEP(3*WFV,2*WFV)-STEP(1*WFV,3*WFV)-STEP(-4*WFV,1*WFV)-STEP(0,-6*WFV),0,PSET,F,PP$:RETURN 18370 *WFX2:ON YY+1 GOTO *WFY20,*WFY21,*WFY22,*WFY23,*WFY24,*WFY25,*WFY26,*WFY27 18380 *WFY20:CONNECT (X+(XXX)*WFV,Y+(YYY-2)*WFV)-STEP(5*WFV,1*WFV)-STEP(-1*WFV,4*WFV)-STEP(-2*WFV,-1*WFV)-STEP(-2*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18390 *WFY21:CONNECT (X+(XXX+2)*WFV,Y+(YYY-2)*WFV)-STEP(2*WFV,1*WFV)-STEP(1*WFV,4*WFV)-STEP(-1*WFV,1*WFV)-STEP(-4*WFV,-1*WFV)-STEP(2*WFV,-5*WFV),0,PSET,F,PP$:RETURN 18400 *WFY22:CONNECT (X+(XXX-2)*WFV,Y+(YYY+1)*WFV)-STEP(2*WFV,-2*WFV)-STEP(4*WFV,1*WFV)-STEP(-1*WFV,3*WFV)-STEP(-3*WFV,1*WFV)-STEP(-2*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18410 *WFY23:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-1*WFV)-STEP(1*WFV,3*WFV)-STEP(0,1*WFV)-STEP(-1*WFV,1*WFV)-STEP(-3*WFV,-1*WFV)-STEP(0,-3*WFV),0,PSET,F,PP$:RETURN 18420 *WFY24:CONNECT (X+(XXX-2)*WFV,Y+(YYY)*WFV)-STEP(2*WFV,-1*WFV)-STEP(3*WFV,1*WFV)-STEP(0,3*WFV)-STEP(-3*WFV,1*WFV)-STEP(-2*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18430 *WFY25:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-1*WFV)-STEP(1*WFV,3*WFV)-STEP(-3*WFV,2*WFV)-STEP(-2*WFV,-1*WFV)-STEP(1*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18440 *WFY26:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-2*WFV)-STEP(1*WFV,2*WFV)-STEP(-2*WFV,4*WFV)-STEP(-4*WFV,-1*WFV)-STEP(2*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18450 *WFY27:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,1*WFV)-STEP(2*WFV,3*WFV)-STEP(-5*WFV,-1*WFV)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18460 *WFX3:ON YY+1 GOTO *WFY30,*WFY31,*WFY32,*WFY33,*WFY34,*WFY35,*WFY36,*WFY37 18470 *WFY30:CONNECT (X+(XXX+1)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,1*WFV)-STEP(-1*WFV,2*WFV)-STEP(-4*WFV,1*WFV)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18480 *WFY31:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,-1*WFV)-STEP(1*WFV,4*WFV)-STEP(-1*WFV,2*WFV)-STEP(-3*WFV,-1*WFV)-STEP(-1*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18490 *WFY32:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,-1*WFV)-STEP(3*WFV,1*WFV)-STEP(1*WFV,2*WFV)-STEP(-3*WFV,2*WFV)-STEP(-3*WFV,-1*WFV)-STEP(1*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18500 *WFY33:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,1*WFV)-STEP(2*WFV,1*WFV)-STEP(0,3*WFV)-STEP(-4*WFV,-2*WFV)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18510 *WFY34:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,-1*WFV)-STEP(0,-1*WFV)-STEP(4*WFV,2*WFV)-STEP(1*WFV,2*WFV)-STEP(-6*WFV,1*WFV)-STEP(0,-3*WFV),0,PSET,F,PP$:RETURN 18520 *WFY35:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(6*WFV,-1*WFV)-STEP(-2*WFV,5*WFV)-STEP(-2*WFV,1*WFV)-STEP(-1*WFV,-2*WFV)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18530 *WFY36:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(2*WFV,-1*WFV)-STEP(1*WFV,1*WFV)-STEP(0,3*WFV)-STEP(-5*WFV,1*WFV)-STEP(2*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18540 *WFY37:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(5*WFV,-1*WFV)-STEP(1*WFV,5*WFV)-STEP(-4*WFV,-1*WFV)-STEP(-2*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18550 *WFX4:ON YY+1 GOTO *WFY40,*WFY41,*WFY42,*WFY43,*WFY44,*WFY45,*WFY46,*WFY47 18560 *WFY40:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(4*WFV,-1*WFV)-STEP(-1*WFV,4*WFV)-STEP(-4*WFV,-1*WFV)-STEP(1*WFV,-2*WFV),0,PSET,F,PP$:RETURN 18570 *WFY41:CONNECT (X+(XXX)*WFV,Y+(YYY-2)*WFV)-STEP(4*WFV,1*WFV)-STEP(2*WFV,1*WFV)-STEP(-2*WFV,4*WFV)-STEP(-3*WFV,-2*WFV)-STEP(-1*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18580 *WFY42:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,-2*WFV)-STEP(3*WFV,2*WFV)-STEP(1*WFV,2*WFV)-STEP(-1*WFV,2*WFV)-STEP(-3*WFV,-2*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN 18590 *WFY43:CONNECT (X+(XXX-2)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-2*WFV)-STEP(3*WFV,2*WFV)-STEP(1*WFV,2*WFV)-STEP(-1*WFV,2*WFV)-STEP(-4*WFV,-3*WFV)-STEP(-2*WFV,-1*WFV),0,PSET,F,PP$:RETURN 18600 *WFY44:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(0,-3*WFV)-STEP(4*WFV,3*WFV)-STEP(0,4*WFV)-STEP(-3*WFV,-2*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN 18610 *WFY45:CONNECT (X+(XXX-1)*WFV,Y+(YYY+3)*WFV)-STEP(2*WFV,-5*WFV)-STEP(3*WFV,2*WFV)-STEP(-1*WFV,2*WFV)-STEP(-3*WFV,2*WFV)-STEP(-1*WFV,-1*WFV),0,PSET,F,PP$:RETURN 18620 *WFY46:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-2*WFV)-STEP(2*WFV,2*WFV)-STEP(-1*WFV,4*WFV)-STEP(-4*WFV,-1*WFV)-STEP(0,-3*WFV),0,PSET,F,PP$:RETURN 18630 *WFY47:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,1*WFV)-STEP(1*WFV,3*WFV)-STEP(-4*WFV,1*WFV)-STEP(-1*WFV,-5*WFV),0,PSET,F,PP$:RETURN 18640 *WFX5:ON YY+1 GOTO *WFY50,*WFY51,*WFY52,*WFY53,*WFY54,*WFY55,*WFY56,*WFY57 18650 *WFY50:CONNECT (X+(XXX+1)*WFV,Y+(YYY-1)*WFV)-STEP(4*WFV,1*WFV)-STEP(0,3*WFV)-STEP(-1*WFV,2*WFV)-STEP(-4*WFV,-2*WFV)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18660 *WFY51:CONNECT (X+(XXX+2)*WFV,Y+(YYY)*WFV)-STEP(2*WFV,1*WFV)-STEP(1*WFV,3*WFV)-STEP(-5*WFV,0)-STEP(2*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18670 *WFY52:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(5*WFV,0)-STEP(-1*WFV,4*WFV)-STEP(-3*WFV,-2*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN 18680 *WFY53:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,-2*WFV)-STEP(3*WFV,2*WFV)-STEP(0,4*WFV)-STEP(-1*WFV,0)-STEP(-2*WFV,-2*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN 18690 *WFY54:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,-2*WFV)-STEP(2*WFV,2*WFV)-STEP(1*WFV,3*WFV)-STEP(-4*WFV,1*WFV)-STEP(0,-4*WFV),0,PSET,F,PP$:RETURN 18700 *WFY55:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(4*WFV,-1*WFV)-STEP(0,4*WFV)-STEP(-3*WFV,1*WFV)-STEP(-2*WFV,-2*WFV)-STEP(1*WFV,-2*WFV),0,PSET,F,PP$:RETURN 18710 *WFY56:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-1*WFV)-STEP(1*WFV,1*WFV)-STEP(-1*WFV,3*WFV)-STEP(-4*WFV,1*WFV)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18720 *WFY57:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(4*WFV,-1*WFV)-STEP(1*WFV,5*WFV)-STEP(-4*WFV,-1*WFV)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18730 *WFX6:ON YY+1 GOTO *WFY60,*WFY61,*WFY62,*WFY63,*WFY64,*WFY65,*WFY66,*WFY67 18740 *WFY60:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-1*WFV)-STEP(0,6*WFV)-STEP(-3*WFV,-2*WFV)-STEP(0,-3*WFV),0,PSET,F,PP$:RETURN 18750 *WFY61:CONNECT (X+(XXX)*WFV,Y+(YYY+1)*WFV)-STEP(1*WFV,-2*WFV)-STEP(3*WFV,2*WFV)-STEP(-3*WFV,3*WFV)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18760 *WFY62:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(2*WFV,1*WFV)-STEP(2*WFV,4*WFV)-STEP(-2*WFV,0)-STEP(-3*WFV,-1*WFV)-STEP(1*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18770 *WFY63:CONNECT (X+(XXX)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,1*WFV)-STEP(1*WFV,2*WFV)-STEP(-4*WFV,1*WFV)-STEP(0,-4*WFV),0,PSET,F,PP$:RETURN 18780 *WFY64:CONNECT (X+(XXX-1)*WFV,Y+(YYY)*WFV)-STEP(1*WFV,0)-STEP(4*WFV,-1*WFV)-STEP(0,4*WFV)-STEP(-4*WFV,0)-STEP(-1*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18790 *WFY65:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,0)-STEP(1*WFV,4*WFV)-STEP(-3*WFV,1*WFV)-STEP(-1*WFV,-1*WFV)-STEP(0,-4*WFV),0,PSET,F,PP$:RETURN 18800 *WFY66:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(3*WFV,-1*WFV)-STEP(1*WFV,5*WFV)-STEP(-5*WFV,-1*WFV)-STEP(1*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18810 *WFY67:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(5*WFV,1*WFV)-STEP(-1*WFV,3*WFV)-STEP(-3*WFV,1*WFV)-STEP(-1*WFV,-5*WFV),0,PSET,F,PP$:RETURN 18820 *WFX7:ON YY+1 GOTO *WFY70,*WFY71,*WFY72,*WFY73,*WFY74,*WFY75,*WFY76,*WFY77 18830 *WFY70:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,3*WFV)-STEP(1*WFV,6*WFV)-STEP(-4*WFV,-3*WFV)-STEP(0,-6*WFV),0,PSET,F,PP$:RETURN 18840 *WFY71:CONNECT (X+(XXX)*WFV,Y+(YYY+1)*WFV)-STEP(4*WFV,3*WFV)-STEP(-1*WFV,1*WFV)-STEP(-4*WFV,0)-STEP(-2*WFV,-1*WFV)-STEP(3*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18850 *WFY72:CONNECT (X+(XXX-1)*WFV,Y+(YYY+1)*WFV)-STEP(4*WFV,0)-STEP(1*WFV,3*WFV)-STEP(-3*WFV,1*WFV)-STEP(-2*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18860 *WFY73:CONNECT (X+(XXX-1)*WFV,Y+(YYY+1)*WFV)-STEP(2*WFV,0)-STEP(3*WFV,-1*WFV)-STEP(-1*WFV,4*WFV)-STEP(-3*WFV,-1*WFV)-STEP(-1*WFV,-2*WFV),0,PSET,F,PP$:RETURN 18870 *WFY74:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,1*WFV)-STEP(1*WFV,4*WFV)-STEP(-4*WFV,-1*WFV)-STEP(0,-4*WFV),0,PSET,F,PP$:RETURN 18880 *WFY75:CONNECT (X+(XXX-1)*WFV,Y+(YYY-1)*WFV)-STEP(1*WFV,0)-STEP(4*WFV,1*WFV)-STEP(-1*WFV,3*WFV)-STEP(-3*WFV,0)-STEP(-1*WFV,-4*WFV),0,PSET,F,PP$:RETURN 18890 *WFY76:CONNECT (X+(XXX)*WFV,Y+(YYY-1)*WFV)-STEP(3*WFV,0)-STEP(1*WFV,2*WFV)-STEP(1*WFV,3*WFV)-STEP(-2*WFV,1*WFV)-STEP(-2*WFV,-1*WFV)-STEP(-1*WFV,-5*WFV),0,PSET,F,PP$:RETURN 18900 *WFY77:CONNECT (X+(XXX+1)*WFV,Y+(YYY)*WFV)-STEP(2*WFV,1*WFV)-STEP(2*WFV,2*WFV)-STEP(-2*WFV,3*WFV)-STEP(-3*WFV,-3*WFV)-STEP(1*WFV,-3*WFV),0,PSET,F,PP$:RETURN 18910 *TESTPATTERN:A=1 18920 FOR X=0 TO 7:FOR Y=0 TO 7 18930 LINE (32*WFV+X*4*WFV,Y*4*WFV)-(32*WFV+(X+1)*4*WFV-1,(Y+1)*4*WFV-1),PSET,%A,BF 18940 A=A+1 18950 NEXT:NEXT:GOSUB *VW1:RETURN 19000 *WFCMD:ON WFCMD+1 GOTO *WFC0,*WFC1,*WFC2,*WFC3:RETURN 19010 *WFC0:PP$=STRING$(8,CHR$(XX+YY*8)):RETURN 19020 *WFC1:P$=FNMP$(CP&(1))+FNMP$(CP&(2)):PP$=P$+P$:P$=FNMP$(CP&(2))+FNMP$(CP&(1)):PP$=PP$+P$+P$:RETURN 19030 *WFC2:PP$=STRING$(8,RIGHT$(FNMP$(CP&(WFV+1)),1)):RETURN 19040 *WFC3:G&=0:B&=0:R&=0 19050 FOR A=0 TO CP:WPP%(0)=VAL("&H"+LEFT$(RIGHT$("00000000"+HEX$(CP&(A)),8),2)):WPP%(1)=(CP&(A) AND &HFF0000)\65536:WPP%(2)=(CP&(A) AND &HFF00)\256:WPP%(3)=CP&(A) AND &HFF 19060 FOR I=0 TO 3 19070 G&=G&+((WPP%(I) AND &HE0)\32):R&=R&+((WPP%(I) AND &H1C)\4):B&=B&+(WPP%(I) AND &H3) 19080 NEXT 19090 NEXT:A=(CP+1)*4:WPP=(G&/A)*32+(R&/A)*4+(B&/A) 19140 PP$=STRING$(8,CHR$(WPP)):RETURN 19200 *WFMCMD:ON WFCMD+1 GOTO *WFC0,*WFCM1,*WFCM2,*WFC3:RETURN 19220 *WFCM1:P$=FNP1$(CP&(0))+FNP2$(CP&(0)):PP$=P$+P$+P$+P$:P$=FNP2$(CP&(0))+FNP1$(CP&(0)):PP$=PP$+P$+P$+P$+P$:RETURN 19230 *WFCM2:PP$=STRING$(8,RIGHT$(FNP1$(CP&(0)),1)):RETURN 19500 *PMETAL 19510 A&=CALLM(OFFSET&,8):IF (A& AND 16)=16 THEN *MESH 19520 GSV=2:GS=24:FOR A=0 TO GS:GS!(A)=A+8:NEXT:M$=" ＜穴の大きさ＞":GOSUB *GETSIZE:WFV=GS!(GSV) 19530 GOSUB *VW3:GET@A (0,0)-(639,479),GB%:LINE (0,0)-(639,479),PSET,0,BF:A&=CALLM(OFFSET&,8) 19540 FOR Y=-WFV TO 479 STEP WFV*2:FOR X=-WFV TO 639 STEP WFV*2:CIRCLE (X,Y),WFV\2,7,,,,F,PSET:CIRCLE (X+WFV,Y+WFV),WFV\2,7,,,,F,PSET:IF INKEY$=CHR$(27) THEN X=1000:Y=1000 19545 NEXT:NEXT:IF X>990 THEN RETURN 19550 GET@ (0,0)-(639,479),ST%,0:PUT@A (0,0)-(639,479),GB%,AND:PUT@ (0,0)-(639,479),ST%,PSET,%COLV:IF (A& AND 16)<>16 THEN RETURN 19560 IF (A& AND 4)=4 THEN *PMETALPR 19570 PASTEL 64:DEF PEN 0,WFV\4:FOR Y=-WFV TO 479 STEP WFV*2:FOR X=-WFV TO 639 STEP WFV*2:CIRCLE (X,Y),WFV\2,7,,,,,PASTEL:CIRCLE (X+WFV,Y+WFV),WFV\2,7,,,,,PASTEL:IF INKEY$=CHR$(27) THEN X=1000:Y=1000 19575 NEXT:NEXT:RETURN 19580 *PMETALPR:CP&(0)=&HCCCC:CP&(1)=&H3333:FOR A=1-(WFV\8) TO WFV\8:FOR Y=-WFV TO 479 STEP WFV*2:FOR X=-WFV TO 639 STEP WFV*2:CIRCLE (X,Y),WFV\2+A,7,,,,,,CP&(A AND 1):CIRCLE (X+WFV,Y+WFV),WFV\2+A,7,,,,,,CP&(A AND 1):IF INKEY$=CHR$(27) THEN X=1000:Y=1000 19590 NEXT:NEXT:RETURN 19600 *MESH 19610 GSV=6:GS=11:FOR A=0 TO GS:GS!(A)=(A+1)*8:NEXT:M$=" ＜線の間隔＞":GOSUB *GETSIZE:WFV=GS!(GSV):B&=A&:A&=CALLM(OFFSET&,8) 19620 GOSUB *VW3:A=(GSV\4)+1:IF (B& AND 4)<>4 THEN PASTEL 128:DEF PEN 0,A+2:OCOLV=0:SWAP OCOLV,COLV:GOSUB *MESH_WRT_P:SWAP OCOLV,COLV:IF X>990 THEN RETURN 19630 PASTEL 256:DEF PEN 0,A:GOSUB *MESH_WRT_P:IF X>990 THEN RETURN 19640 IF (A& AND 20)=0 THEN RETURN 19650 IF (A& AND 4)<>4 THEN PASTEL 64:DEF PEN 0,A*3:GOSUB *MESH_WRT_P:RETURN 19660 DEF PEN 0,1:CP&(0)=&HCCCC:CP&(1)=&H3333:FOR I=-A TO A+A:FOR Y=-WFV TO 479+WFV STEP WFV+A*2:FOR X=0 TO 639+WFV STEP WFV+A 19670 CONNECT (X+I,Y)-STEP(WFV\2-A*4,WFV\2-A*4)-STEP(A,A)-STEP(A*3,A*3)-STEP(0,A*2)-STEP(-A*3,A*3)-STEP(-A,A)-STEP(-(WFV\2-A*4),WFV\2-A*4)-STEP(0,A*2),%COLV,PSET,N,CP&(I AND 1) 19680 CONNECT (X+WFV-1+I,Y+1)-STEP(-(WFV\2-A*4),WFV\2-A*4)-STEP(-A,A)-STEP(-A*3,A*3)-STEP(0,A)-STEP(A*3,A*3)-STEP(A,A)-STEP(WFV\2-A*4,WFV\2-A*4)-STEP(0,A*2),%COLV,PSET,N,CP&(I AND 1):IF INKEY$=CHR$(27) THEN X=1000:Y=1000:I=1000 19690 NEXT:NEXT:NEXT:RETURN 19700 *MESH_WRT_P:FOR Y=-WFV TO 479+WFV STEP WFV+A*2:FOR X=0 TO 639+WFV STEP WFV+A 19710 CONNECT (X,Y)-STEP(WFV\2-A*4,WFV\2-A*4)-STEP(A,A)-STEP(A*3,A*3)-STEP(0,A*2)-STEP(-A*3,A*3)-STEP(-A,A)-STEP(-(WFV\2-A*4),WFV\2-A*4)-STEP(0,A*2),%COLV,PASTEL 19720 CONNECT (X+WFV-1,Y+1)-STEP(-(WFV\2-A*4),WFV\2-A*4)-STEP(-A,A)-STEP(-A*3,A*3)-STEP(0,A)-STEP(A*3,A*3)-STEP(A,A)-STEP(WFV\2-A*4,WFV\2-A*4)-STEP(0,A*2),%COLV,PASTEL:IF INKEY$=CHR$(27) THEN X=1000:Y=1000 19730 NEXT:NEXT:RETURN 19800 *PILE 19810 GOSUB *MENUWRT:OCOLV=255:SWAP OCOLV,COLV:GOSUB *COLDISP:SWAP OCOLV,COLV:SYMBOL (10+MENX,372),"ＰＡＳＴＥＬ",1,1,0:SYMBOL (10+MENX,392),"ＯＲ",1,1,0:SYMBOL (10+MENX,412),"ＡＮＤ",1,1,0 19820 SYMBOL (10+MENX,432),"ＸＯＲ",1,1,0:SYMBOL (10+MENX,452),"ＭＡＴＴＥ",1,1,0:MOUSE 1,,,1 19830 *PGS_LOOP:MFLG=0:WHILE MFLG=0:MFLG=ABS(MOUSE(2,0)+MOUSE(2,1)*2):WEND:IF (MFLG AND 2)=2 THEN WHILE MOUSE(6,1)=0:WEND:GOSUB *COLDISP:GOSUB *MENUOFF:RETURN 19840 WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0):MY=MOUSE(1) 19850 IF MX<MENX+7 OR MY<372 OR MX>MENX+150 OR MY>467 THEN *PGS_LOOP 19860 MY=(MY-372)\20:IF MY<0 OR MY>4 THEN *PGS_LOOP 19870 GOSUB *MENUOFF:GOSUB *EXCHG_BUF:ON MY+1 GOSUB *PPAS,*POR,*PAND,*PXOR,*PMAT 19880 RETURN 19900 *PPAS:PASTEL 128:PUT@A (0,0)-(639,479),GB%,PASTEL:RETURN 19910 *POR:PUT@A (0,0)-(639,479),GB%,OR:RETURN 19920 *PAND:PUT@A (0,0)-(639,479),GB%,AND:RETURN 19930 *PXOR:PUT@A (0,0)-(639,479),GB%,XOR:RETURN 19940 *PMAT:PUT@A (0,0)-(639,479),GB%,MATTE,,,%COLV:RETURN 20000 *STAMP:IF STF<>0 THEN *DO_STAMP 20010 OCOLV=255:SWAP OCOLV,COLV:GOSUB *COLDISP:SWAP OCOLV,COLV:GOSUB *VW1:CALLM OFFSET&,9,&H130,STMP&,&H14,VARPTR(ST%(0)),46080:PUT@A (928,0)-(1023,479),ST%,PSET 20020 GET@ (1008,0)-(1023,15),STPM0%,0:PUT@ (13+MENX,388)-(28+MENX,403),STPM0%,PSET,0:LINE (12+MENX,387)-(29+MENX,404),PSET,0,B:PUT@ (30+MENX,388)-(45+MENX,403),STPM0%,PSET,0 20030 GET@ (1008,240)-(1023,255),STPM0%,0:PUT@ (47+MENX,388)-(62+MENX,403),STPM0%,PSET,0:LINE (46+MENX,387)-(63+MENX,404),PSET,0,B:PUT@ (64+MENX,388)-(79+MENX,403),STPM0%,PSET,0 20040 GET@ (992,0)-(1007,15),STPM0%,0:PUT@ (81+MENX,388)-(96+MENX,403),STPM0%,PSET,0:LINE (80+MENX,387)-(97+MENX,404),PSET,0,B:PUT@ (98+MENX,388)-(113+MENX,403),STPM0%,PSET,0 20050 GET@ (992,240)-(1007,255),STPM0%,0:PUT@ (115+MENX,388)-(130+MENX,403),STPM0%,PSET,0:LINE (114+MENX,387)-(131+MENX,404),PSET,0,B:PUT@ (132+MENX,388)-(147+MENX,403),STPM0%,PSET,0 20060 SYMBOL (MENX+7,368),"Stamp Panel",1,1,0,,,3,2:SYMBOL (MENX+8,368),"Stamp Panel",1,1,0,,,3,2 20070 GET@ (960,0)-(975,15),STPM0%,0:PUT@ (13+MENX,422)-(28+MENX,437),STPM0%,PSET,0:LINE (12+MENX,421)-(29+MENX,438),PSET,0,B:PUT@ (30+MENX,422)-(45+MENX,437),STPM0%,PSET,0 20080 GET@ (960,240)-(975,255),STPM0%,0:PUT@ (47+MENX,422)-(62+MENX,437),STPM0%,PSET,0:LINE (46+MENX,421)-(63+MENX,438),PSET,0,B:PUT@ (64+MENX,422)-(79+MENX,437),STPM0%,PSET,0 20500 *STS_LOOP:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:MX=MOUSE(0)-MENX:MY=MOUSE(1) 20510 IF (MY-387) MOD 34>17 THEN *STS_LOOP 20520 MX=(MX-12) \ 17:MY=(MY-387) \ 34:IF MX<0 OR MX>7 OR MY<0 OR MY>1 THEN *STS_LOOP 20530 IF MX>3 AND MY=1 THEN *STS_LOOP 20540 STF=(MX MOD 2)+(MY*2)+1:MML$="@14V5O7T240b8":MML1$="@75V7O2T240e8":GOSUB *PLAY 20550 ON STF GOSUB *MONO_STAMP_GET,*MONO_STAMP2_GET,*MONO_STAMPBIG_GET,*MONO_STAMPBIG2_GET',*COL_STAMP_GET 20570 *DO_STAMP:STA=1:GOSUB *UNDOGET:ON STF GOSUB *MONO_STAMP,*MONO_STAMP2,*MONO_STAMPBIG,*MONO_STAMPBIG2 ',*COL_STAMP 20580 GOSUB *MENUWRT:RETURN 20600 *MONO_STAMP_GET 20610 A=MX:MX=1008-((A \ 4)*16):MY=((A\2) MOD 2)*240 20620 GET@ (MX,MY)-(MX+15,MY+15),STPM0%,0:GET@ (MX,MY+16)-(MX+15,MY+31),STPM1%,0:GET@ (MX,MY+32)-(MX+15,MY+47),STPM2%,0:GET@ (MX,MY+48)-(MX+15,MY+63),STPM3%,0 20630 GET@ (MX,MY+64)-(MX+15,MY+79),STPM4%,0:GET@ (MX,MY+80)-(MX+15,MY+95),STPM5%,0:GET@ (MX,MY+96)-(MX+15,MY+111),STPM6%,0:GET@ (MX,MY+112)-(MX+15,MY+127),STPM7%,0 20640 GET@ (MX,MY+128)-(MX+15,MY+143),STPM8%,0:GET@ (MX,MY+144)-(MX+15,MY+159),STPM9%,0:GET@ (MX,MY+160)-(MX+15,MY+175),STPM10%,0:GET@ (MX,MY+176)-(MX+15,MY+191),STPM11%,0 20650 GET@ (MX,MY+192)-(MX+15,MY+207),STPM12%,0:GET@ (MX,MY+208)-(MX+15,MY+223),STPM13%,0:GET@ (MX,MY+224)-(MX+15,MY+239),STPM14%,0:RETURN 20700 *MONO_STAMP2_GET 20710 GOSUB *MONO_STAMP_GET:GET@A (MX,MY)-(MX+15,MY+239),STP0%:RETURN 21000 *MONO_STAMP 21010 GOSUB *MOS_WAIT:MOUSE 1,,,0:MML$="@75V7O5T240":GOSUB *PLAY:WHILE MOUSE(6,0)=0:MML$="b8":GOSUB *PLAY:GOSUB *MSTAMP:GOSUB *PAL_SHIFT:A&=CALLM(OFFSET&,8):WAIT A&+3 21020 WEND:RETURN 21030 *MSTAMP 21040 GOSUB *MXY:ON STA GOSUB *MST0,*MST1,*MST2,*MST3,*MST4,*MST5,*MST6,*MST7,*MST8,*MST9,*MST10,*MST11,*MST12,*MST13,*MST14 21050 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0 21060 STA=STA+1:IF STA>15 THEN STA=1 21070 RETURN 21100 *MST0:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM0%,PSET,%COLV:RETURN 21110 *MST1:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM1%,PSET,%COLV:RETURN 21120 *MST2:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM2%,PSET,%COLV:RETURN 21130 *MST3:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM3%,PSET,%COLV:RETURN 21140 *MST4:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM4%,PSET,%COLV:RETURN 21150 *MST5:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM5%,PSET,%COLV:RETURN 21160 *MST6:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM6%,PSET,%COLV:RETURN 21170 *MST7:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM7%,PSET,%COLV:RETURN 21180 *MST8:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM8%,PSET,%COLV:RETURN 21190 *MST9:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM9%,PSET,%COLV:RETURN 21200 *MST10:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM10%,PSET,%COLV:RETURN 21210 *MST11:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM11%,PSET,%COLV:RETURN 21220 *MST12:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM12%,PSET,%COLV:RETURN 21230 *MST13:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM13%,PSET,%COLV:RETURN 21240 *MST14:PUT@ (MX-8,MY-8)-(MX+7,MY+7),STPM14%,PSET,%COLV:RETURN 21500 *MONO_STAMP2 21510 GOSUB *MOS_WAIT:MOUSE 1,,,0:MML$="@75V7O6T240":GOSUB *PLAY:WHILE MOUSE(6,0)=0:MML$="g8":GOSUB *PLAY:GOSUB *MSTAMP2:GOSUB *PAL_SHIFT:A&=CALLM(OFFSET&,8):WAIT A&+3 21520 WEND:RETURN 21530 *MSTAMP2 21540 GOSUB *MXY:PUT@A (MX-8,MY-8)-(MX+7,MY+7),STP0%,MATTE,,,%1,128*(STA-1):ON STA GOSUB *MST0,*MST1,*MST2,*MST3,*MST4,*MST5,*MST6,*MST7,*MST8,*MST9,*MST10,*MST11,*MST12,*MST13,*MST14 21550 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0 21560 STA=STA+1:IF STA>15 THEN STA=1 21570 RETURN 22000 *MONO_STAMPBIG_GET 22010 A=MX:MX=960-((A \ 4)*32):MY=((A\2) MOD 2)*240+16 22020 GET@ (MX,MY)-(MX+31,MY+31),STPM0%,0:GET@ (MX,MY+32)-(MX+31,MY+63),STPM1%,0:GET@ (MX,MY+64)-(MX+31,MY+95),STPM2%,0:GET@ (MX,MY+96)-(MX+31,MY+127),STPM3%,0 22030 GET@ (MX,MY+128)-(MX+31,MY+159),STPM4%,0:GET@ (MX,MY+160)-(MX+31,MY+191),STPM5%,0:GET@ (MX,MY+192)-(MX+31,MY+223),STPM6%,0 22040 RETURN 22100 *MONO_STAMPBIG2_GET 22110 GOSUB *MONO_STAMPBIG_GET:GET@A (MX,MY)-(MX+31,MY+223),STP0%:RETURN 22500 *MONO_STAMPBIG 22510 GOSUB *MOS_WAIT:MOUSE 1,,,0:MML$="@75V7O5T240":GOSUB *PLAY:WHILE MOUSE(6,0)=0:MML$="b8":GOSUB *PLAY:GOSUB *MSTAMPBIG:GOSUB *PAL_SHIFT:A&=CALLM(OFFSET&,8):WAIT A&+3 22520 WEND:RETURN 22530 *MSTAMPBIG 22540 GOSUB *MXY:ON STA GOSUB *MSTB0,*MSTB1,*MSTB2,*MSTB3,*MSTB4,*MSTB5,*MSTB6 22550 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0 22560 STA=STA+1:IF STA>7 THEN STA=1 22570 RETURN 22600 *MSTB0:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM0%,PSET,%COLV:RETURN 22610 *MSTB1:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM1%,PSET,%COLV:RETURN 22620 *MSTB2:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM2%,PSET,%COLV:RETURN 22630 *MSTB3:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM3%,PSET,%COLV:RETURN 22640 *MSTB4:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM4%,PSET,%COLV:RETURN 22650 *MSTB5:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM5%,PSET,%COLV:RETURN 22660 *MSTB6:PUT@ (MX-16,MY-16)-(MX+15,MY+15),STPM6%,PSET,%COLV:RETURN 22800 *MONO_STAMPBIG2 22810 GOSUB *MOS_WAIT:MOUSE 1,,,0:MML$="@75V7O6T240":GOSUB *PLAY:WHILE MOUSE(6,0)=0:MML$="g8":GOSUB *PLAY:GOSUB *MSTAMPBIG2:GOSUB *PAL_SHIFT:A&=CALLM(OFFSET&,8):WAIT A&+3 22820 WEND:RETURN 22830 *MSTAMPBIG2 22840 GOSUB *MXY:PUT@A (MX-16,MY-16)-(MX+15,MY+15),STP0%,MATTE,,,%1,512*(STA-1):ON STA GOSUB *MSTB0,*MSTB1,*MSTB2,*MSTB3,*MSTB4,*MSTB5,*MSTB6 22850 IF SP=1 THEN COLV=COLV+1:IF COLV>255 THEN COLV=0 22860 STA=STA+1:IF STA>7 THEN STA=1 22870 RETURN 23000 *TEXT:RETURN 23010 GOSUB *MENUOFF:GET@A (0,240)-(639,359),ST%:GET@A (0,360)-(639,479),MGB%:LINE (0,240)-(639,479),PSET,0,BF,7 29900 GOSUB *MENUWRT:RETURN 30000 *FILELOAD:MML$="@8V7O5Q4T160E4C4D4Q8":GOSUB *PLAY:WHILE PLAY(0):WEND 30010 TM$="ロード":RWFLG=0:ON ERROR GOTO 30250:GOSUB 30020:IF YN=0 THEN GOSUB *CDCONTT:RETURN ELSE GOSUB *CHECK_COMP:IF YN=0 THEN GOSUB *CDCONTT:RETURN ELSE LOAD@ FFD$+DFF$:GOSUB *GET_PALETTE:GOSUB *CDCONTT:RETURN 30020 GOSUB *INPUT:YN=FDFLG:IF YN=0 THEN RETURN 30030 ON ERROR GOTO 30250:IF INSTR(DFF$,".")=0 THEN DFF$=LEFT$(DFF$,8)+".TIF":GOTO 30060 30040 A=INSTR(DFF$,"."):IF LEN(DFF$)-A>3 OR A<2 THEN BEEP:YN=0:RETURN 30050 IF MID$(DFF$,A,4)<>".TIF" THEN DFF$=LEFT$(DFF$,A-1)+".TIF" 30060 DFF$=PATH$+DFF$:RETURN 30070 *INPUT 30080 RADBUT=0:RCMD=1:WC$="*.TIF":FDM$="読み込むTIFファイルを指定して下さい｡" 30090 GOSUB *FILE_DIALOG:IF FDFLG=0 THEN RETURN ELSE IF RIGHT$(PATH$,1)<>"\" THEN PATH$=PATH$+"\" 30100 FFD$=DRIVE$:DFF$=F_NAME$:RETURN 30110 *FILESAVE:MML$="@8V7O5Q4T160E4C4D4Q8":GOSUB *PLAY:WHILE PLAY(0):WEND 30120 TM$="セーブ":RWFLG=1:ON ERROR GOTO 30250:GOSUB 30130:IF YN=0 THEN GOSUB *CDCONTT:RETURN ELSE GOSUB *SAVECMP:GOSUB *CDCONTT:RETURN 30130 GOSUB *INPUT_SAVE:YN=FDFLG:IF YN=0 THEN RETURN 30140 ON ERROR GOTO 30250:IF INSTR(DFF$,".")=0 THEN DFF$=LEFT$(DFF$,8)+".TIF":GOTO 30170 30150 A=INSTR(DFF$,"."):IF LEN(DFF$)-A>3 OR A<2 THEN BEEP:YN=0:RETURN 30160 IF MID$(DFF$,A,4)<>".TIF" THEN DFF$=LEFT$(DFF$,A-1)+".TIF" 30170 DFF$=PATH$+DFF$:RETURN 30180 *INPUT_SAVE 30190 RADBUT=4:RCMD=2:WC$="*.TIF":FDM$="保存するTIFファイルを設定して下さい｡":RADBUT$(0)="CLUT&圧縮なし":RADBUT$(1)="CLUT付TIFF":RADBUT$(2)="圧縮TIFF":RADBUT$(3)="CLUT&圧縮TIFF":RETFLG(0)=0:RETFLG(1)=0 30200 GOSUB *FILE_DIALOG:IF FDFLG=0 THEN RETURN ELSE IF RIGHT$(PATH$,1)<>"\" THEN PATH$=PATH$+"\" 30210 FFD$=DRIVE$:DFF$=F_NAME$:RETURN 30220 *ERR_PUT_PIC:MOUSE 4,0,0,639,479:PUT@A (0,0)-(639,479),GB%:RETURN 30230 *ERR_GET_PIC:LINE (EX,EY)-(EX+300,EY+36),PSET,7,BF,0:RETURN 30240 *ERR_COMP:M$="現バージョンでは圧縮TIFFは未サポートです":GOSUB 30440:RETURN 30250 GOSUB *PAL_INI:GOSUB *ERR_GET_PIC:ERRV=ERR 30255 IF ERRV=112 THEN M$="256色TIFFではありません":GOSUB 30440:RESUME NEXT 30260 *ERRV_IN:IF ERRV=28 AND ERL=30010 THEN GOSUB *ERR_COMP:RESUME NEXT 30270 IF ERRV=64 THEN M$="指定のファイルは既に存在しています":GOSUB 30390:IF YN=0 THEN RESUME NEXT ELSE KILL FFD$+DFF$:RESUME 30280 IF ERRV=53 THEN M$="入出力装置に異常が発生しました":GOSUB 30440:RESUME NEXT 30290 IF ERRV=55 THEN M$="ファイルの記述に誤りがあります":GOSUB 30440:RESUME NEXT 30300 IF ERRV=60 THEN M$="指定の入出力装置は使用できません":GOSUB 30440:RESUME NEXT 30310 IF ERRV=63 THEN M$="指定のファイルが見つかりません":GOSUB 30440:RESUME NEXT 30320 IF ERRV=65 THEN M$="ディスクのディレクトリ領域がいっぱいです":GOSUB 30440:RESUME NEXT 30330 IF ERRV=67 THEN M$="ディスクに空き領域がありません":GOSUB 30440:RESUME NEXT 30340 IF ERRV=71 THEN M$="ディスクのファイルの構成が正しくありません":GOSUB 30440:RESUME NEXT 30350 IF ERRV=72 THEN M$="ディスク装置が使用可能な状態になっていません":GOSUB 30440:RESUME NEXT 30360 IF ERRV=73 THEN M$="指定されたディスクは書込が禁止されています":GOSUB 30390:IF YN=0 THEN RESUME NEXT ELSE RESUME 30370 IF ERRV=75 THEN M$="アクセスが拒否されました":GOSUB 30440:RESUME NEXT 30380 PRINT "エラーが発生しました。 ID =";ERR;" Line =";ERL:A$=INPUT$(1):END 30385 *TORIJIK:GOSUB 30420:SYMBOL (EX+170,EY+20),"取消実行",1,1,7:LINE (EX+170,EY+18)-(EX+225,EY+36),PSET,2,B:LINE (EX+281,EY+18)-(EX+281,EY+36),PSET,2:MOUSE 1,EX+202,EY+24,1:GOTO 30400 30390 GOSUB 30420:SYMBOL (EX+170,EY+20),"中断続行",1,1,7:SYMBOL (EX+202,EY+28),"[取消] [実行]",.5!,.5!,7:LINE (EX+170,EY+18)-(EX+225,EY+36),PSET,2,B:LINE (EX+281,EY+18)-(EX+281,EY+36),PSET,2:MOUSE 1,EX+202,EY+24,1 30400 MOUSE 4,EX+170,EY+18,EX+281,EY+36:A$="":WHILE MOUSE(2,0)=0 AND A$<>CHR$(13) AND A$<>CHR$(24):A$=INKEY$:WEND:IF A$="" THEN WHILE MOUSE(6,0)=0:WEND:YN=MOUSE(0)\(EX+231):GOSUB *ERR_PUT_PIC:RETURN 30410 YN=SGN(24-ASC(A$)):GOSUB *ERR_PUT_PIC:RETURN 30420 ML=KLEN(M$):IF ML<19 THEN SYMBOL (EX+6,EY+2),M$,1,1,7 ELSE IF ML<25 THEN SYMBOL (EX+6,EY+2),M$,.75!,1,7 ELSE SYMBOL (EX+6,EY+2),M$,.5!,1,7 30430 IF ERRV<>0 THEN SYMBOL (EX+2,EY+20),"Error ID ="+FNF$(ERRV),1,1,7 30435 LINE (EX,EY+18)-(EX+300,EY+18),PSET,2:RETURN 30440 GOSUB 30420:SYMBOL (EX+230,EY+20),"確認",1,1,7:LINE (EX+228,EY+18)-(EX+263,EY+36),PSET,2,B:MOUSE 1,EX+246,EY+24,1:MOUSE 4,EX+228,EY+18,EX+263,EY+36:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:GOSUB *ERR_PUT_PIC:RETURN 30450 LINE (EX+114,EY+1)-(EX+297,EY+17),PSET,0,BF:RETURN 30460 *CHECK_COMP 30470 ON ERROR GOTO *CHECK_ERR 30480 OPEN "I",#1,FFD$+DFF$ 30490 DUM$=INPUT$(&H42,1):DUM$=INPUT$(2,1):CMPFLG%=ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256:CLOSE #1 30500 IF CMPFLG%<>1 THEN GOSUB *LOADCMP:ERRV=28:YN=0:RETURN 'GOSUB *ERR_GET_PIC:ERRV=28:GOSUB *ERR_COMP:YN=0:RETURN 30510 *CHECK_RET 30520 ON ERROR GOTO 30250:YN=1:RETURN 30530 *CHECK_ERR 30540 RESUME *CHECK_RET 30550 *HUKIDASHI 30560 ML=LEN(M$)*8+4:IF PPX+ML-1>639 THEN PPX=639-ML 30570 GET@A (PPX,376)-(PPX+ML,397),ST%:CONNECT (OPPX-20,397)-(OPPX-23,393)-(PPX,393)-(PPX,376)-(PPX+ML,376)-(PPX+ML,393)-(OPPX-16,393)-(OPPX-20,397),PC,PSET,F,0 30580 SYMBOL (PPX+2,377),M$,1,1,7:RETURN 30590 *HUKIDASHIOFF 30600 PUT@A (PPX,376)-(PPX+ML,397),ST%:RETURN 30610 *MESSAGEW:PC=7:PLAY OFF:M$=M$+"●":GOSUB *HUKIDASHI:PLAY "@29V8O4T120E8C8":WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:GOSUB *HUKIDASHIOFF:RETURN 35000 *EXCHG_BUFFER 35010 FOR A=0 TO 14:GET@A (0,A*32)-(639,A*32+31),ST%:PUT@A (0,480)-(639,511),ST%:PUT@A (0,A*32)-(639,A*32+31),GB%,PSET,,,,A*10240:GET@A (0,480)-(639,511),GB%,A*10240:NEXT:RETURN 40000 *CDSTART 40010 ON ERROR GOTO *CDERR 40020 CDINF CDDAT%:CDC=CDDAT%(1):CDMN=CDDAT%(5) 40030 IF CDC=2 THEN *CDSRET 40040 *CDSTART_IN:CDSTAT CDDAT% 40050 IF CDDAT%(1)=1 THEN *CDSRET 40060 CD PLAY:CDP=0 40070 *CDSRET 40080 ON ERROR GOTO 0:RETURN 40090 *CDCHK:IF INKEY$=CHR$(13) THEN CDP=0 40100 ON ERROR GOTO *CDERR 40110 IF CDP<5 THEN CDSTAT CDDAT% ELSE *CDCRET 40120 IF CDDAT%(1)=1 THEN *CDCRET ELSE CD STOP 40130 M$="CD演奏が終了しました｡クリックしてください｡":GOSUB *MESSAGEW 40140 CDP=CDP+1:GOTO *CDSTART 40150 *CDCRET 40160 ON ERROR GOTO 0:RETURN 40170 *CDERR 40180 IF ERR=53 THEN CDC=0:CDMN=0:RESUME *CDSRET 40190 IF ERR=5 THEN RESUME *CDSTART 40200 IF ERR=115 THEN RESUME *CDSTART 40210 M$="CD ERROR"+STR$(ERR)+"IN"+STR$(ERL):GOSUB *MESSAGEW:RESUME *CDSTOP 40220 *CDSTOP:IF CDC=0 OR CDC=2 THEN RETURN 40230 ON ERROR GOTO *CDERR:CD STOP:ON ERROR GOTO 0:RETURN 40240 *CDPAUSE:IF CDC=0 OR CDC=2 THEN RETURN 40250 ON ERROR GOTO *CDERR:CD PAUSE:ON ERROR GOTO 0:RETURN 40260 *CDCONT:IF CDC=0 OR CDC=2 THEN RETURN 40270 ON ERROR GOTO *CDERR:CD CONT:ON ERROR GOTO 0:RETURN 40280 *CDNEXT:IF CDC=0 OR CDC=2 THEN RETURN ELSE ON ERROR GOTO *CDERR 40290 CDINF CDDAT%:CDMN=CDDAT%(5) 40300 CDSTAT CDDAT%:IF CDDAT%(1)=0 THEN CPN=0 ELSE CPN=CDDAT%(5) 40310 CPN=CPN+1:IF CDMN<CPN THEN CPN=CDC 40320 CD PLAY CPN,CDMN:ON ERROR GOTO 0:RETURN 40330 *CDPREV:IF CDC=0 OR CDC=2 THEN RETURN ELSE ON ERROR GOTO *CDERR 40340 CDINF CDDAT%:CDMN=CDDAT%(5) 40350 CDSTAT CDDAT%:IF CDDAT%(1)=0 THEN CPN=CDMN+1 ELSE CPN=CDDAT%(5) 40360 CPN=CPN-1:IF CPN<CDC THEN CPN=CDMN 40370 CD PLAY CPN,CDMN:ON ERROR GOTO 0:RETURN 40380 *CDGETT:IF CDC=0 OR CDC=2 THEN RETURN ELSE ON ERROR GOTO *CDERR 40390 CDSTAT CDDAT%:IF CDDAT%(1)=0 THEN CPN=0:RETURN ELSE CPN=CDDAT%(5) 40400 CDT%(0)=CDDAT%(2):CDT%(1)=CDDAT%(3):CDT%(2)=CDDAT%(4):GOTO *CDSTOP 40410 *CDCONTT:IF CDC=0 OR CDC=2 OR CPN=0 THEN RETURN ELSE ON ERROR GOTO *CDERR 40420 CDINF CDDAT%:CDC=CDDAT%(1):CDMN=CDDAT%(5) 40430 IF CDC=2 THEN *CDSRET 40440 CDSTAT CDDAT%:IF CDDAT%(1)=1 THEN *CDSRET 40450 CD PLAY (CDT%(0),CDT%(1),CDT%(2)):CDP=0:GOTO *CDSRET 40460 *CDINFO:ON ERROR GOTO *CDERR 40470 CDINF CDDAT%:CDC=CDDAT%(1):CDMN=CDDAT%(5) 40480 GOTO *CDSRET 41000 *PAL_INI 41010 PALETTE:CALLM TS,0,GW&,2,0,VARPTR(PALT%(0,0)):RETURN 41020 RETURN 41030 *PALETTE_CHANGE 41040 AH=4:AL=1:ESI&=VARPTR(PALT%(0,0)):GOSUB *EGB:RETURN 41060 *PAL_SHIFT:IF PALF=0 THEN RETURN ELSE IF STP=0 THEN STP=1 41070 ESI&=VARPTR(PALT%(0,0)):P=0 41080 FOR A=PST TO 254 STEP 32:G=FNP(A,2):R=FNP(A,1):B=FNP(A,0) 41090 IF (A MOD 3)=PCHG THEN SWAP G,R:SWAP B,R:GOTO 41160 ELSE G=G+GAV%(A):R=R+RAV%(A):B=B+BAV%(A) 41100 IF G>255 THEN G=255:GAV%(A)=-1*STP 41110 IF G<0 THEN G=1:GAV%(A)=1*STP 41120 IF R>255 THEN R=254:RAV%(A)=-1*STP 41130 IF R<0 THEN R=0:RAV%(A)=1*STP 41140 IF B>255 THEN B=254:BAV%(A)=-1*STP 41150 IF B<0 THEN B=1:BAV%(A)=1*STP 41160 POKE ESI&+A*8+8,B:POKE ESI&+A*8+9,R:POKE ESI&+A*8+10,G:PALETTE A,[G,R,B],NZF 41170 'LED%(P MOD 6)=15-(INP(&H4EC) AND 15):IF (P MOD 3)=0 AND PLSV=1 THEN PALETTE 0,[LED%(0)*LED%(1),LED%(2)*LED%(3),LED%(4)*LED%(5)],NZF 41175 IF (P MOD 3)=0 THEN IF PLSV=1 THEN LED%=ADS%(INP(&H4E7)):PALETTE 0,[LED%,LED%,LED%],NZF ELSE PALETTE 0,0 41180 P=P+1:NEXT:PST=PST+1:IF PST>31 THEN PST=1 41190 PCHG=PCHG+1:IF PCHG>2 THEN PCHG=0 41200 RETURN 41500 *GET_PALETTE 41510 CALLM TS,0,GW&,2,0,VARPTR(PALT%(0,0)):CALLM TS,0,GW&,2,0,VARPTR(PALT%(0,1)):RETURN 42000 *PAL_INI_ORG 42010 AH=4:AL=1:ESI&=VARPTR(PALT%(0,1)):GOSUB *EGB:GOSUB *GET_PALETTE:RETURN 42020 RETURN 50000 *SCMODE 50010 SCREEN@ 2:AH=1:AL=0:EDX&=12:GOSUB *EGB:AH=5:AL=0:GOSUB *EGB:RETURN 50020 *EGB 50030 A&=CALLM(EGB,AH,AL,EBX&,ECX&,EDX&,ESI&,RET&) 50040 IF A&<>0 THEN BEEP:PRINT "EGBの実行に失敗しました":A$=INPUT$(1):END 50050 RETURN 51000 *SAVECMP:RCMD=RCMD-1:IF (RCMD AND 2)=0 THEN SAVE@ FFD$+DFF$,(0,0)-(639,479),(RCMD AND 1):RETURN 51010 ON ERROR GOTO *CMPERR:F$=FFD$+DFF$+CHR$(0):F&=PEEK(VARPTR(F$),4):COMP=(RCMD AND 2)*2+1:ERRV=0:OPEN "I",#1,FFD$+DFF$:CLOSE:IF ERRV=0 THEN ON ERROR GOTO 30250:OPEN "O",#1,FFD$+DFF$:CLOSE:IF YN=0 THEN RETURN 51020 IF ERRV<>64 THEN RETURN 52000 IF (RCMD AND 1)=1 THEN P&=VARPTR(PALT%(0,0)):CALLM TS,0,GW&,2,0,P& ELSE P&=0 52010 MOUSE 1,,,0:A&=CALLM(TS,F&,0,0,639,479,32768,1024,VARPTR(LBUF%(0,0)),GW&,P&,COMP,2,0,0):MOUSE 1,,,1:IF A&=0 THEN RETURN 52020 GOSUB *PAL_INI:GOSUB *ERR_GET_PIC:M$="ファイル出力中にエラーが発生しました("+RIGHT$(" "+STR$(A& AND &HFFFF),5)+")":GOSUB 30440:RETURN 52100 *CMPERR:ERRV=ERR:IF ERRV=63 THEN ERRV=64:RESUME NEXT ELSE GOTO 30250 55000 *LOADCMP:POKE VARPTR(PALT%(0,0)),0,4:F$=FFD$+DFF$+CHR$(0):F&=PEEK(VARPTR(F$),4):MOUSE 1,,,0:A&=CALLM(TL,F&,0,0,65536,32768,VARPTR(LBUF%(0,0)),GW&,VARPTR(PALT%(0,0)),VARPTR(ST%(32867))+1,2,0):MOUSE 1,,,1 55010 IF PEEK(VARPTR(PALT%(0,0)),4)=0 THEN GOSUB *PAL_INI 55020 IF A&<>0 AND A&<>-131069 THEN GOSUB *PAL_INI:GOSUB *ERR_GET_PIC:M$="ファイル入力中にエラーが発生しました("+RIGHT$(" "+STR$(VAL("&H"+RIGHT$("0000"+HEX$(A&),4))),5)+")":GOSUB 30440:RETURN 55030 GOSUB *GET_PALETTE:RETURN 60000 *FILE_DIALOG:ON ERROR GOTO *エラー処理:PA$=PATH$:D=ASC(DRIVE$):IF RIGHT$(PA$,1)<>CHR$(0) THEN PA$=PA$+CHR$(0) 60010 A&=FRE(4):CALLM OFFSET&,3,D:CALLM OFFSET&,4,VARPTR(PA$):ON RIFLG+1 GOTO *RADBUT_IN0,*RADBUT_IN1,*RADBUT_IN2 60020 *RADBUT_IN0:IF MEF=2 THEN MOUSE 1,,,0:MEF=3 60030 GOSUB *CDGETT:GET@A (0,0)-(639,511),GB%:SCREEN@ 0:CONSOLE 0,25:COLOR 7,,,0:CLS:PALETTE 60040 MOUSE 0:MOUSE 1,FDXM+200,FDYM+320,1:MEF=2:'MOUSE 4,FDXM+25,FDYM-4,FDXM+320,FDYM+349 60050 LOCATE FDX+21-(LEN(TM$)\2),FDY:PRINT TM$;:LOCATE FDX+22,FDY+15:PRINT "実行取消";:LOCATE FDX+30,FDY+1:PRINT " 0KB";:LOCATE FDX+22,FDY+4:PRINT "親"; 60060 LOCATE FDX+22,FDY+5:PRINT "↑";:LOCATE FDX+22,FDY+13:PRINT "↓";:LOCATE FDX+6,FDY+2:PRINT "《　　　》"; 60070 LINE(FDXM+25,FDYM-4)-(FDXM+320,FDYM+349),PSET,0,BF,%8:LINE(FDXM+25,FDYM-4)-(FDXM+320,FDYM+349),PSET,0,BF,%8:LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,B 60080 LINE(FDXM+38,FDYM+283)-(FDXM+153,FDYM+302),PSET,7,B:LINE(FDXM+38,FDYM+74)-(FDXM+153,FDYM+92),PSET,7,B:LINE(FDXM+39,FDYM+26)-(FDXM+153,FDYM+64),PSET,7,B 60090 LINE(FDXM+172,FDYM+282)-(FDXM+209,FDYM+302),PSET,7,B:LINE(FDXM+220,FDYM+282)-(FDXM+257,FDYM+302),PSET,7,B:LINE(FDXM+236,FDYM+18)-(FDXM+297,FDYM+36),PSET,7,B 60100 LINE(FDXM+172,FDYM+74)-(FDXM+194,FDYM+92),PSET,7,B:LINE(FDXM+172,FDYM+94)-(FDXM+194,FDYM+112),PSET,7,B:LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,B 60110 LINE(FDXM+172,FDYM+245)-(FDXM+194,FDYM+264),PSET,7,B:LINE(FDXM+76,FDYM+26)-(FDXM+116,FDYM+64),PSET,7,B 60120 GOSUB *PUT_FDMES 60130 *初期化 60140 MOFF=0 60150 RESTORE *CLICK_AREA 60160 FOR I=1 TO MAXCMD 60170 FOR J=1 TO 4 60180 READ XY(I,J) 60190 NEXT J 60200 NEXT I 60210 *RADBUT_IN1 60220 GOSUB *RADIO_BUTTON 60230 GOSUB *接続ドライブ 60240 GOSUB *GETCD 60250 C=15:GOSUB *DRV_HYO 60260 GOSUB *GETDIR 60270 IF RET&=-1 THEN GOSUB *NOT_DRV:GOTO *FD_MAIN_LOOP 60280 GOSUB *SEARCH 60290 GOSUB *DISK_FREE 60300 GOSUB *SORT 60310 F_NUM=1 60320 GOSUB *HYOUJI 60330 *RADBUT_IN2:FDFLG=0 60340 *FD_MAIN_LOOP 60350 MX=MOUSE(0)-FDXM:MY=MOUSE(1)-FDYM 60360 J=0:A$=INKEY$:IF A$=CHR$(13) THEN J=CANCMD-1 ELSE IF A$=CHR$(24) THEN J=CANCMD 60370 FOR I=1 TO MAXCMD 60380 IF MOUSE(2,0) AND MX>XY(I,1) AND MX<XY(I,3) THEN IF MY>XY(I,2) AND MY<XY(I,4) THEN J=I:I=100 60390 NEXT I 60400 IF J THEN *ON_MOUSE 60410 GOTO *FD_MAIN_LOOP 60420 *ON_MOUSE 60430 IF MOFF AND J>3 AND J<>CANCMD AND J<>BUTCMD THEN *FD_MAIN_LOOP 60440 ON J GOSUB *ON_LEFT,*ON_DRV,*ON_RIGHT,*ON_OYA,*ON_LIST,*ON_UP,*ON_DOWN,*ON_RUN,*ON_CANCEL,*ON_INPUT,*ON_SCROLL_BAR,*ON_BUTTON 60450 GOTO *FD_MAIN_LOOP 60460 *ON_LEFT 60470 MOFF=1 60480 GOSUB *LEFT_DRV 60490 C=7:GOSUB *DRV_HYO 60500 GOSUB *HYOUJI:WAIT 10 60510 RETURN 60520 *ON_DRV 60530 WHILE MOUSE(2,0)<>0:WEND 60540 MOFF=0 60550 FILENAME$="" 60560 GOSUB *HYOUJI_SPC 60570 GOSUB *DRV_SENTAKU 60580 RETURN 60590 *ON_RIGHT 60600 MOFF=1 60610 GOSUB *RIGHT_DRV 60620 C=7:GOSUB *DRV_HYO 60630 GOSUB *HYOUJI:WAIT 10 60640 RETURN 60650 *ON_UP 60660 IF F_NUM>1 THEN F_NUM=F_NUM-1:GOSUB *HYOUJI 60670 RETURN 60680 *ON_DOWN 60690 IF F_NUM<F_S-8 THEN F_NUM=F_NUM+1:GOSUB *HYOUJI 60700 RETURN 60710 *ON_OYA 60720 WHILE MOUSE(2,0)<>0:WEND 60730 DUMMYY$=SPACE$(14):DUMMYP$="."+CHR$(0) 60740 A=CALLM (OFFSET&,0,VARPTR(DUMMYP$),VARPTR(DUMMYY$),&H10,0) 60750 IF A=0 THEN SHELL "CD .." 60760 GOSUB *ON_DRV 60770 RETURN 60780 *ON_LIST 60790 I=0 60800 IF F_S<9 THEN K=F_S ELSE K=9 60810 IF K=0 OR FILE_SU=-1 THEN RETURN 60820 FOR J=1 TO K 60830 IF MY<95+19*J THEN I=J:J=10 60840 NEXT J 60850 IF I THEN GOSUB *SETFILE 60860 RETURN 60870 *SETFILE 60880 FILENAME$=MID$(FILE_NAME$(F_NUM+I-1+ROOT),2,14) 60890 IF ASC(FILENAME$)=60 THEN *SETDIR 60900 GOSUB *HYOUJI 60910 COLOR ,,,5:LOCATE FDX+5,FDY+4+I:PRINT " "+FNFF$(MID$(FILENAME$,2,12))+" ";:COLOR 7,,,4 60920 LOCATE FDX+6,FDY+15:PRINT MID$(FILENAME$,2,12); 60930 RETURN 60940 *SETDIR 60950 DIR$=MID$(FILENAME$,2,12) 60960 GOSUB *CDDIRMOVE 60970 GOSUB *ON_DRV 60980 RETURN 60990 *ON_RUN 61000 IF LEFT$(MID$(FILENAME$,2,12)+SPACE$(12),12)=SPACE$(12) THEN RETURN ELSE FDFLG=1 61010 DRIVE$=MID$(DRV_SET$,DRV_NO,1)+":":PATH$=LEFT$(DIR$,INSTR(DIR$+" "," ")-1):F_NAME$=MID$(FILENAME$,2,12):F_NAME$=LEFT$(F_NAME$,INSTR(F_NAME$+" "," ")-1) 61020 RETURN *RET_RET 61030 *ON_CANCEL 61040 FDFLG=0 61050 RETURN *RET_RET 61060 *RET_RET:RIFLG=0:SCREEN@ 2:CLS:GOSUB *VW0:PUT@A (0,0)-(639,511),GB%:GOSUB *PALETTE_CHANGE:ON ERROR GOTO 0:CALLM OFFSET&,3,ASC(DFD$):CALLM OFFSET&,4,VARPTR(DFP$):RETURN 61070 *ON_INPUT:IF RWFLG=0 THEN RETURN 61080 FT$=MID$(FILENAME$,2,12):WHILE RIGHT$(FT$,1)=" ":FT$=LEFT$(FT$,LEN(FT$)-1):WEND 61090 CP=LEN(FT$):FLAG=0 61100 K$="" 61110 WHILE K$<>CHR$(13) 61120 CP=LEN(FT$):LINE(FDXM+40,FDYM+284)-(FDXM+152,FDYM+301),PSET,1,BF:LINE ((FDX+6+CP)*8+1,FDYM+285)-((FDX+6+CP)*8+1,FDYM+300),PSET,2 61130 K$=INPUT$(1) 61140 IF K$=CHR$(8) OR K$=CHR$(29) THEN GOSUB *IN_DEL_LAST_C:GOTO *IN_PUT 61150 IF K$<CHR$(33) THEN *P_SKP ELSE FT$=FT$+K$ 61160 CP=LEN(FT$):IF CP>12 THEN BEEP:FT$=LEFT$(FT$,12):CP=12:GOTO *P_SKP 61170 IF INSTR(FT$,".")>9 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP 61180 IF CP=9 AND INSTR(FT$,".")<2 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP 61190 IF CP>INSTR(FT$,".")+3 AND INSTR(FT$,".")>1 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP 61200 *IN_PUT 61210 LOCATE FDX+6,FDY+15:PRINT LEFT$(FT$+" ",12)+" "; 61220 *P_SKP 61230 WEND 61240 LINE(FDXM+40,FDYM+284)-(FDXM+152,FDYM+301),PSET,%8,BF 61250 FILENAME$="F"+LEFT$(FT$+" ",12)+CHR$(0) 61260 RETURN 61270 *IN_DEL_LAST 61280 CP=LEN(FT$)-1:BEEP:FT$=LEFT$(FT$,CP):RETURN 61290 *IN_DEL_LAST_C 61300 IF LEN(FT$)=0 THEN BEEP:RETURN ELSE FT$=KLEFT$(FT$,KLEN(FT$)-1):CP=LEN(FT$):RETURN 61310 *ON_BUTTON 61320 OCMD=RCMD:RCMD=((MY-76)\19)+1 61330 IF RCMD>RADBUT THEN RCMD=OCMD:RETURN 61340 GOSUB *DISP_RADIO 61350 IF RETFLG(RCMD-1)=0 THEN RETURN ELSE RETURN *RADBUTRET 61360 *RADBUTRET 61370 FDFLG=2:COLOR ,,,0:RETURN 61380 *RADIO_BUTTON:IF RADBUT=0 THEN RETURN 61390 GOSUB *DISP_RADIO 61400 FOR I=0 TO RADBUT-1 61410 LOCATE FDX+27,FDY+4+I:PRINT RADBUT$(I); 61420 NEXT 61430 RETURN 61440 *DISP_RADIO:IF RADBUT=0 THEN RETURN 61450 FOR I=0 TO RADBUT-1 61460 LOCATE FDX+25,FDY+4+I:PRINT "○"; 61470 NEXT 61480 IF RCMD<>0 THEN LOCATE FDX+25,FDY+3+RCMD:PRINT "●"; 61490 RETURN 61500 *SCROLL_BAR 61510 LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,BF,%8 61520 IF MOFF=1 OR F_S<10 THEN IF MOFF=1 THEN RETURN ELSE LINE(FDXM+173,FDYM+113)-(FDXM+193,FDYM+244),PSET,0,BF,%15:RETURN 61530 BOX_Y1=BOX_S!*(F_NUM-1):BOX_Y2=130-(BOX_Y1+BOX_RH) 61540 IF BOX_Y2<0 THEN BOX_Y2=0 61550 IF BOX_Y1>B_MAX THEN BOX_Y1=B_MAX 61560 LINE (FDXM+173,FDYM+113+BOX_Y1)-(FDXM+193,FDYM+244-BOX_Y2),PSET,0,BF,%15 61570 RETURN 61580 *ON_SCROLL_BAR 61590 IF MOFF=1 OR F_S<10 THEN RETURN 61600 IF F_S<9 THEN F_NUM_HYO=FILE_SU ELSE F_NUM_HYO=F_NUM+8+ROOT 61610 IF ( ROOT=2 AND F_NUM_HYO=2 ) OR FILE_SU=0 THEN RETURN 61620 IF MY<BOX_Y1+113 OR MY>244-BOX_Y2 THEN B_Y1=(MY-113-(BOX_RH/2)):GOTO *SCROLL_CLICK ELSE OI=257 61630 WHILE MOUSE(2,0)<>0:MY=MOUSE(1)-FDYM:B_Y1=(MY-113-(BOX_RH/2)):OI=I:I=B_Y1/BOX_S! 61640 IF I<0 THEN I=0 61650 IF I>F_S-9 THEN I=F_S-9 61660 I=I+1:B_Y1=BOX_S!*(I-1):B_Y2=130-(B_Y1+BOX_RH) 61670 IF B_Y2<0 THEN B_Y2=0 61680 IF B_Y1>B_MAX THEN B_Y1=B_MAX 61690 IF OI<>I THEN LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,BF,%8:LINE (FDXM+173,FDYM+113+B_Y1)-(FDXM+193,FDYM+244-B_Y2),PSET,0,BF,%15 61700 WEND:GOTO *SCROLL_RET 61710 *SCROLL_CLICK:I=B_Y1/BOX_S! 61720 IF I<0 THEN I=0 61730 IF I>F_S-9 THEN I=F_S-9 61740 I=I+1 61750 *SCROLL_RET 61760 F_NUM=I:GOSUB *HYOUJI 61770 RETURN 61780 *LEFT_DRV 61790 DRV_NO=DRV_NO-1 61800 IF DRV_NO=0 THEN DRV_NO=DRV_SU 61810 RETURN 61820 *RIGHT_DRV 61830 DRV_NO=DRV_NO+1 61840 IF DRV_NO>DRV_SU THEN DRV_NO=1 61850 RETURN 61860 *DRV_SENTAKU 61870 F_NUM=1:C=15:GOSUB *DRV_HYO 61880 GOSUB *CDMOVE 61890 GOSUB *GETDIR 61900 IF RET&=-1 THEN GOSUB *NOT_DRV:RETURN 61910 GOSUB *SEARCH 61920 GOSUB *DISK_FREE 61930 GOSUB *SORT 61940 GOSUB *HYOUJI 61950 RETURN 61960 *GETCD 61970 DMMY$=CHR$(CALLM (OFFSET&,1)) 61980 DRV_NO=INSTR(1,DRV_SET$,DMMY$) 61990 RETURN 62000 *GETDIR 62010 DMMY$=MID$(DRV_SET$,DRV_NO,1) 62020 DIR$=SPACE$(65) 62030 RET&=CALLM(OFFSET&,2,ASC(DMMY$),VARPTR(DIR$)) 62040 I=KINSTR(DIR$,"\") 62050 J=I 62060 WHILE I 62070 J=I 62080 I=KINSTR(J+1,DIR$,"\") 62090 WEND 62100 LOCATE FDX+6,FDY+4:PRINT KMID$(DIR$,J+1,12); 62110 RETURN 62120 *CDMOVE 62130 DMMY$=MID$(DRV_SET$,DRV_NO,1) 62140 SHELL DMMY$+":": 62150 RETURN 62160 *CDDIRMOVE 62170 DIR$=DIR$+CHR$(0) 62180 CALLM OFFSET&,4,VARPTR(DIR$) 62190 RETURN 62200 *SEARCH:A&=FRE(1):LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,BF,%1':IF BASCOM=1 THEN *SEARCH_COM 62210 GOSUB *SEARCH_DIR 62220 PATH_ALL$=WC$+CHR$(0) 62230 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(FILE_SU+1)),0,0) 62240 IF A<>0 THEN RETURN ELSE FILE_SU=FILE_SU+1 62250 FILE_NAME$(FILE_SU)="2 "+MID$(FILE_NAME$(FILE_SU),2,12)+" " 62260 FOR I=FILE_SU+1 TO 256 62270 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(I)),0,1) 62280 IF A<>0 THEN FILE_SU=I-1:I=257:GOTO *LOOPOUT ELSE FILE_SU=I 62290 KAKUNO$=FILE_NAME$(I) 62300 FILE_NAME$(I)="2 "+MID$(KAKUNO$,2,12)+" " 62310 *LOOPOUT 62320 NEXT I 62330 RETURN 62340 *SEARCH_DIR 62350 PATH_ALL$="*.*"+CHR$(0) 62360 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(1)),&H10,0) 62370 ROOT=0:FILE_SU=0 62380 IF A<>0 THEN RETURN ELSE FILE_SU=2 62390 IF KMID$(FILE_NAME$(1),2,1)="." THEN ROOT=2 62400 IF ASC(FILE_NAME$(1))=68 THEN FILE_NAME$(1)="1<"+MID$(FILE_NAME$(1),2,12)+">" ELSE FILE_SU=1 62410 FOR I=FILE_SU TO 256 62420 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(I)),&H10,1) 62430 IF A<>0 THEN FILE_SU=I-1:I=257:GOTO *LOOPOUTD ELSE FILE_SU=I 62440 KAKUNO$=FILE_NAME$(I) 62450 IF ASC(KAKUNO$)=68 THEN FILE_NAME$(I)="1<"+MID$(KAKUNO$,2,12)+">" ELSE I=I-1 62460 *LOOPOUTD 62470 NEXT I 62480 RETURN 62490 *SORT 62500 I=FILE_SU\2 62510 J=1:FLG=0 62520 *SORT1 62530 IF J+I>FILE_SU THEN IF FLG=1 THEN J=1:FLG=0 ELSE I=I\2:J=1:FLG=0:IF I=0 THEN *SCROLL_CALC 62540 IF FILE_NAME$(J)>FILE_NAME$(J+I) THEN SWAP FILE_NAME$(J),FILE_NAME$(J+I):FLG=1 62550 J=J+1 62560 GOTO *SORT1 62570 *SCROLL_CALC 62580 F_S=FILE_SU-ROOT:LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,BF,%8 62590 IF F_S<10 THEN BOX_S!=1:BOX_RH=0:BOX_H=130:B_MAX=243:RETURN 62600 BOX_S!=130/F_S:BOX_SS!=130/(F_S-9) 62610 BOX_RH=BOX_S!*9:BOX_H=130-BOX_RH:B_MAX=113+BOX_H 62620 RETURN 62630 *HYOUJI 62640 GOSUB *SCROLL_BAR:IF MOFF=1 THEN COLOR 1 ELSE COLOR 7 62650 IF F_S<9 THEN F_NUM_HYO=FILE_SU ELSE F_NUM_HYO=F_NUM+8+ROOT 62660 IF ( ROOT=2 AND F_NUM_HYO=2 ) OR FILE_SU=0 THEN *HYOUJI_RET 62670 FOR J=F_NUM+ROOT TO F_NUM_HYO 62680 LOCATE FDX+5,FDY+5+J-(F_NUM+ROOT):IF LEFT$(FILE_NAME$(J),1)="1" THEN PRINT MID$(FILE_NAME$(J),2,14) ELSE PRINT " "+FNFF$(MID$(FILE_NAME$(J),3,12))+" "; 62690 NEXT J 62700 *HYOUJI_RET 62710 COLOR 7:RETURN 62720 *HYOUJI_SPC 62730 FOR J=0 TO 8 62740 LOCATE FDX+5,FDY+5+J:PRINT SPC(14); 62750 NEXT J 62760 LOCATE FDX+6,FDY+15:PRINT SPC(12); 62770 RETURN 62780 *DRV_HYO':C=15:MC=8 62790 X=208:Y=67:LINE (X,Y)-(X+31,Y+31),PSET,%8,BF:K=ASC(MID$(DRV_KIND$,DRV_NO,1)):IF MID$(DRV_SET$,DRV_NO,1)="Q" THEN I=67 ELSE IF K=0 THEN I=68 ELSE IF K=2 THEN I=71 ELSE IF K=3 THEN I=73 ELSE I=26 62800 IF I=67 THEN GOSUB *DISP_ICON ELSE MI=ASC(MID$(DRV_SET$,DRV_NO,1))-17:GOSUB *DISP_ICON_A 62820 RETURN 62830 *DISK_FREE 62840 DFREE&=0 62850 DFREE&=DSKF(ASC(MID$(DRV_SET$,DRV_NO,1))-ASC("A")) 62860 LOCATE FDX+30,FDY+1:IF DFREE&<1024 THEN PRINT USING "#,###KB";DFREE&; ELSE PRINT USING "###.#MB";DFREE&/1024; 62870 RETURN 62880 *接続ドライブ 62890 DRV_SET$="":DRV_KIND$="" 62900 J=0:A&=0 62910 INFOR$=STRING$(200,0) 62920 CALLM OFFSET&,7,VARPTR(INFOR$) 62930 A&=PEEK(VARPTR(INFOR$),4) 62940 FOR I&=&H30 TO &H4F STEP 2 62950 IF PEEK(A&+I&)<>255 THEN DRV_SET$=DRV_SET$+CHR$(&H41+J):DRV_KIND$=DRV_KIND$+CHR$(PEEK(A&+I&)) 62960 J=J+1 62970 NEXT 62980 DRV_SET$=DRV_SET$+"Q" 62990 DRV_SU=LEN(DRV_SET$) 63000 RETURN 63010 *PUT_FDMES 63020 FDMT$=LEFT$(FDM$,68):IF LEN(FDMT$)=68 THEN IF KTYPE(FDM$,KLEN(FDMT$))=1 THEN FDMT$=LEFT$(FDM$,67) 63030 LOCATE FDX+4,FDY+16:PRINT SPC(40);:LOCATE FDX+4,FDY+17:PRINT SPC(40); 63040 LOCATE FDX+4,FDY+16 63050 WHILE LEN(FDMT$)>0 63060 IF KTYPE(FDMT$,1)=1 AND POS(0)=FDX+37 THEN PRINT " "; 63070 IF POS(0)>FDX+37 THEN LOCATE FDX+4,FDY+17:IF LEN(FDMT$)>34 THEN IF KTYPE(FDMT$,KLEN(FDMT$))=1 THEN FDMT$=KLEFT$(FDMT$,KLEN(FDMT$)-1) ELSE FDMT$=LEFT$(FDMT$,34) 63080 PRINT KLEFT$(FDMT$,1);:IF LEN(FDMT$)<>0 THEN FDMT$=KRIGHT$(FDMT$,KLEN(FDMT$)-1) 63090 WEND 63100 COLOR 7,,,4 63110 RETURN 63120 *NOT_DRV 63130 BEEP:M$="指定されたディスク装置が使用可能な状態になっていません" 63140 COLOR 2,,,4 63150 SWAP FDM$,M$:GOSUB *PUT_FDMES 63160 WHILE MOUSE(2,0)=0 AND MOUSE(2,1)=0:WEND 63170 SWAP FDM$,M$:GOSUB *PUT_FDMES 63180 FILE_SU=0 63190 ROOT=0 63200 MOFF=1 63210 RETURN 63220 *エラー処理 63230 IF ERR=72 THEN GOSUB *NOT_DRV 63240 RESUME NEXT 63250 *CLICK_AREA 63260 DATA 41,26,76,64, 76,26,116,64, 116,26,153,64, 172,74,194,92, 38,93,153,264, 172,94,194,112, 172,245,194,264, 172,282,209,304, 220,282,257,304, 38,283,153,302, 172,112,194,245, 198,74,311,264 63270 FOR I&=&H30 TO &H4F STEP 2 63280 IF PEEK(A&+I&)<>255 THEN DRV_SET$=DRV_SET$+CHR$(&H41+J) 63290 J=J+1 63300 *DISP_ICON:CALLM OFFSET&,9,&H108,I*256+160*1024,&H14,VARPTR(DICN%(0)),128:PUT@ (X,Y)-(X+31,Y+31),DICN%,PSET,%C:RETURN 63310 DRV_SET$=DRV_SET$+"Q" 63320 DRV_SU=LEN(DRV_SET$) 63330 RETURN 63350 *DISP_ICON_M:CALLM OFFSET&,9,&H108,I*256+160*1024+128,&H14,VARPTR(DICN%(0)),128:FOR A=0 TO 63:DICN%(A)=NOT DICN%(A):NEXT:PUT@ (X,Y)-(X+31,Y+31),DICN%,PSET,%MC 63360 CALLM OFFSET&,9,&H108,I*256+160*1024,&H14,VARPTR(DICN%(0)),128:PUT@ (X,Y)-(X+31,Y+31),DICN%,PSET,%C:RETURN 63370 *DISP_ICON_A:CALLM OFFSET&,9,&H108,I*256+160*1024,&H14,VARPTR(DICN%(0)),128:CALLM OFFSET&,9,&H108,MI*256+160*1024,&H14,VARPTR(DICN%(64)),256:FOR A=0 TO 63:DICN%(A)=DICN%(A) AND DICN%(A+128) OR DICN%(A+64):NEXT 63380 PUT@ (X,Y)-(X+31,Y+31),DICN%,PSET,%C:RETURN 63390 IF KTYPE(FDMT$,1)=1 AND POS(0)=FDX+37 THEN PRINT " "; 63400 *GET_STARTUP:DFP$=SPACE$(65):DFD$=CHR$(CALLM (OFFSET&,1))+":":CALLM OFFSET&,2,ASC(DFD$),VARPTR(DFP$):DFP$=LEFT$(DFP$,INSTR(DFP$+" "," ")-1):IF RIGHT$(DFP$,1)<>"\" THEN DFP$=DFP$+"\" 63410 PATH$=DFP$:DRIVE$=DFD$:DFP$=DFP$+CHR$(0):RETURN